diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,19 @@
 # Revision history for jordan
 
-## 0.1.0.0 -- YYYY-mm-dd
+## 0.2.0.0 - 2022-07-04
 
+* Removed support for serializing to `Text`.
+* Removed support for parsing via Megaparsec.
+* Added support for parsing directly to a value or an error report, via a custom unbox-sum-based parser type.
+* Added `parseFieldWithDefault`.
+* Added `serializeJust`.
+* Changed the methods of `JSONObjectSerializer` and `JSONTupleSerializer` to be more consistent with the rest of the library.
+* Got rid of mandatory identifiers for object parsers.
+* Got rid of mandatory identifiers for object serializers.
+* Improved Generic Deriving Mechanisms.
+* Lots of optimizations.
+
+## 0.1.0.0 -- ???
+
 * First version. Released on an unsuspecting world.
+* I forgot to document this originally.
diff --git a/jordan.cabal b/jordan.cabal
--- a/jordan.cabal
+++ b/jordan.cabal
@@ -1,6 +1,6 @@
 cabal-version:      2.4
 name:               jordan
-version:            0.1.0.0
+version:            0.2.0.0
 synopsis:           JSON with Structure
 
 -- A longer description of the package.
@@ -38,30 +38,32 @@
     , bytestring >= 0.10.8.1 && <0.12
     , containers >= 0.6.2 && <0.7
     , scientific >= 0.3.7 && <0.4
-    , text >= 1.2.3.0 && <1.3
-    , megaparsec >= 9.1.0 && <9.2
+    , text >= 1.2.3.0 && <2.1
     , contravariant >= 1.5.5 && <1.6
     , parser-combinators >= 1.3.0 && < 1.4
+    , deepseq >= 1.4 && <= 1.5
+    , ghc-prim >= 0.6.1 && <0.9
+    , base >= 4.14.1 && <4.17
 
 library
     import: build-deps
     exposed-modules:
         Jordan.FromJSON.Class
-      , Jordan.FromJSON.Megaparsec
       , Jordan.FromJSON.Attoparsec
-      , Jordan.FromJSON.ParseInternal
+      , Jordan.FromJSON.Internal.Attoparsec
+      , Jordan.FromJSON.Internal.UnboxedParser
+      , Jordan.FromJSON.Internal.Permutation
+      , Jordan.FromJSON.Internal.UnboxedReporting
+      , Jordan.FromJSON.UnboxedReporting
+      , Jordan.Types.Internal.MergeMap
+      , Jordan.Types.Internal.AccumE
+      , Jordan.Types.JSONValue
+      , Jordan.Types.JSONType
+      , Jordan.Types.JSONError
       , Jordan.ToJSON.Class
-      , Jordan.ToJSON.Text
       , Jordan.ToJSON.Builder
       , Jordan.Generic.Options
       , Jordan
-
-    -- Modules included in this library but not exported.
-    -- other-modules:
-
-    -- LANGUAGE extensions used by modules in this package.
-    -- other-extensions:
-    build-depends:    base ^>=4.14.1.0
     hs-source-dirs:   lib
     default-language: Haskell2010
 
@@ -75,14 +77,13 @@
       , QuickCheck
       , quickcheck-text
     other-modules:
-        Jordan.FromJSON.MegaparsecSpec
-      , Jordan.FromJSON.AttoparsecSpec
+        Jordan.FromJSON.AttoparsecSpec
+      , Jordan.FromJSON.UnboxedReportingSpec
       , Jordan.SpecDefs
-      , Jordan.ToJSON.TextSpec
       , Jordan.ToJSON.BuilderSpec
       , Jordan.RoundTripSpec
     default-language: Haskell2010
     type:             exitcode-stdio-1.0
     hs-source-dirs:   test
     main-is:          JordanSpec.hs
-    build-depends:    base ^>=4.14.1.0
+    ghc-options: -fprint-potential-instances
diff --git a/lib/Jordan.hs b/lib/Jordan.hs
--- a/lib/Jordan.hs
+++ b/lib/Jordan.hs
@@ -2,39 +2,84 @@
 --
 -- Has all functionality for parsing and serializing JSON.
 module Jordan
-    ( -- * JSON Parsing
-      -- ** Concretely
-      parseViaMegaparsec
-    , parseViaAttoparsec
-    , runParserViaAttoparsec
-    , runParserViaMegaparsec
-    , attoparsecParser
-    , megaparsecParser
-      -- ** Abstractly
-    , FromJSON (..)
-    , JSONParser (..)
-    , JSONObjectParser (..)
-    , JSONTupleParser (..)
-      -- *** Generically
-    , gFromJSON
-    , FromJSONOptions (..)
-      -- * JSON Serialization
-      -- ** Concretely
-    , toJSONAsBuilder
-    , toJSONViaBuilder
-    , toJSONText
-      -- ** Abstractly
-    , ToJSON (..)
-    , JSONSerializer (..)
-    , JSONObjectSerializer (..)
-      -- *** Generically
-    , gToJSON
-    , ToJSONOptions (..)
-    ) where
+  ( -- * JSON Parsing
 
+    -- ** Abstractly
+    FromJSON (..),
+    JSONParser (..),
+    JSONObjectParser (..),
+    JSONTupleParser (..),
+
+    -- ** Concretely
+
+    -- *** Via Attoparsec
+    -- $viaAP
+    parseViaAttoparsec,
+    parseViaAttoparsecWith,
+    attoparsecParser,
+    attoparsecParserFor,
+
+    -- *** With Error Reporting
+    -- $withReport
+    parseOrReport,
+    parseOrReportWith,
+
+    -- *** Generically
+    gFromJSON,
+    FromJSONOptions (..),
+
+    -- * JSON Serialization
+
+    -- ** Abstractly
+    ToJSON (..),
+    JSONSerializer (..),
+    JSONObjectSerializer (..),
+
+    -- **** Re-Exports for Serialization
+    Contravariant (..),
+    Divisible (..),
+    Selectable (..),
+
+    -- ** Concretely
+    toJSONAsBuilder,
+    toJSONViaBuilder,
+
+    -- *** Generically
+    gToJSON,
+    ToJSONOptions (..),
+
+    -- * Parsing or Serializing Arbitrary JSON
+    JSONValue (..),
+
+    -- * Newtypes for DerivingVia
+    WithOptions (..),
+    OmitNothingFields,
+    KeepNothingFields,
+  )
+where
+
+import Data.Functor.Contravariant
+import Data.Functor.Contravariant.Divisible
 import Jordan.FromJSON.Attoparsec
 import Jordan.FromJSON.Class
-import Jordan.FromJSON.Megaparsec
+import Jordan.FromJSON.UnboxedReporting
+import Jordan.Generic.Options
 import Jordan.ToJSON.Builder (toJSONAsBuilder, toJSONViaBuilder)
 import Jordan.ToJSON.Class
-import Jordan.ToJSON.Text (toJSONText)
+import Jordan.Types.JSONValue (JSONValue (..))
+
+-- $viaAP
+--
+-- These parsers use the excellent Attoparsec library to do their work.
+-- This means that they're quite fast, but that they also provide less-than-ideal error messages.
+-- You should use these when speed is needed, or when you're reasonably certain that nobody will make a mistake.
+-- APIs intended only for internal use, for example.
+
+-- $withReport
+--
+-- These parsers parse to either a value or an *error report*, which is a detailed report of what exactly what wrong.
+-- This uses a roll-our-own parsing library based on *unboxed sums*.
+-- It's been tested via QuickCheck, but it is doing some spooky-scary raw pointer opertions.
+--
+-- This is a bit slower than the attoparsec parser, but *much* better at error handling.
+-- Use it for external-facing APIs---assuming that you trust my ability to write primops.
diff --git a/lib/Jordan/FromJSON/Attoparsec.hs b/lib/Jordan/FromJSON/Attoparsec.hs
--- a/lib/Jordan/FromJSON/Attoparsec.hs
+++ b/lib/Jordan/FromJSON/Attoparsec.hs
@@ -1,276 +1,115 @@
+{-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
 -- | Implementation of FromJSON parsers via Attoparsec.
 --
 -- This module does not construct intermediate data structures like maps or key-value lists,
 -- and instead uses permutation parsers in order to parse your data structure directly.
+-- This means that it is pretty fast!
+-- However, you also get basically *zero* error reporting, which is generally not what you want.
 module Jordan.FromJSON.Attoparsec
-    ( convertParserToAttoparsecParser
-    , runParserViaAttoparsec
-    , parseViaAttoparsec
-    , attoparsecParser
-    ) where
+  ( attoparsecParserFor,
+    parseViaAttoparsecWith,
+    parseViaAttoparsec,
+    attoparsecParser,
+  )
+where
 
-import Control.Applicative (Alternative(..))
+import Control.Applicative (Alternative (..))
+import Control.Monad (void, when)
 import Data.Attoparsec.ByteString ((<?>))
+import qualified Data.Attoparsec.ByteString as A
 import qualified Data.Attoparsec.ByteString as AP
 import qualified Data.Attoparsec.ByteString.Char8 as CH
+import qualified Data.Attoparsec.Combinator as AC
 import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Unsafe as B
 import Data.Char (chr, digitToInt, isControl, isHexDigit, ord)
 import Data.Functor (void, ($>))
-import Data.Monoid (Alt(..))
+import Data.Monoid (Alt (..))
 import Data.Scientific (Scientific)
+import qualified Data.Scientific as Sci
+import qualified Data.Scientific as Scientific
 import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Debug.Trace
 import Jordan.FromJSON.Class
-import Jordan.FromJSON.ParseInternal
+import Jordan.FromJSON.Internal.Attoparsec
+import Jordan.FromJSON.Internal.Permutation
 import Numeric (showHex)
-import qualified Text.Megaparsec as Text
 
-newtype ObjectParser a
-  = ObjectParser
-  { runObjectParser :: Permutation AP.Parser a }
+newtype ObjectParser a = ObjectParser
+  {runObjectParser :: Permutation AP.Parser a}
   deriving (Functor, Applicative)
 
-newtype ArrayParser a
-  = ArrayParser
-  { runArrayParser :: AP.Parser a }
+type role ArrayParser representational
+
+data ArrayParser a
+  = ParseNoEffect a
+  | ParseWithEffect (AP.Parser a)
   deriving (Functor)
 
 instance Applicative ArrayParser where
-  pure = ArrayParser . pure
-  f <*> a = ArrayParser $ do
-    f' <- runArrayParser f
-    comma
-    a' <- runArrayParser a
-    pure $ f' a'
-
-skipSpace :: AP.Parser ()
-skipSpace = AP.skipWhile isSpace
-  where
-    isSpace = \case
-      32 -> True
-      10 -> True
-      13 -> True
-      9 -> True
-      _ -> False
-
-lexeme :: AP.Parser a -> AP.Parser a
-lexeme a = a <* skipSpace
-
-label :: String -> AP.Parser a -> AP.Parser a
-label l p = p <?> l
-
-parseAnyField :: AP.Parser ()
-parseAnyField = label "junk field" $ void $  do
-  lexeme parseJSONText
-  labelSep
-  lexeme anyDatum
-
-junkFieldAtEnd :: AP.Parser ()
-junkFieldAtEnd = void $ do
-  comma
-  parseAnyField `AP.sepBy` comma
-
-comma :: AP.Parser ()
-comma = label "comma character" $ void $ lexeme (AP.string ",")
-
-quotation :: AP.Parser ()
-quotation = label "quotation mark" $ void $ AP.word8 34
-
-parseJSONText :: AP.Parser Text.Text
-parseJSONText = label "JSON text" $ do
-  quotation
-  innerText
-
-innerText :: AP.Parser Text.Text
-innerText = do
-  chunk <- AP.takeWhile $ \char -> char /= 92 && char /= 34
-  l <- AP.peekWord8
-  case l of
-    Nothing -> fail "string without end"
-    Just 34 -> do
-      AP.anyWord8
-      pure $ decodeUtf8 chunk
-    Just 92 -> do
-      AP.anyWord8
-      r <- label "escape value" parseEscape
-      rest <- innerText
-      pure $ decodeUtf8 chunk <> r <> rest
-    Just _ -> fail "IMPOSSIBLE"
-
-parseEscape :: AP.Parser Text.Text
-parseEscape
-  = quote
-  <|> backslash
-  <|> solidus
-  <|> backspace
-  <|> formfeed
-  <|> linefeed
-  <|> carriage
-  <|> tab
-  <|> escaped
-  where
-    backslash = AP.string "\\" $> "\\"
-    quote = AP.string "\"" $> "\""
-    solidus = AP.string "/" $> "/"
-    backspace = AP.string "b" $> "\b"
-    formfeed = AP.string "f" $> "\f"
-    linefeed = AP.string "n" $> "\n"
-    carriage = AP.string "r" $> "\r"
-    tab = AP.string "t" $> "\t"
-    escaped = do
-      AP.string "u"
-      a <- parseHexDigit
-      b <- parseHexDigit
-      c <- parseHexDigit
-      d <- parseHexDigit
-      let s = (((a * 16) + b) * 16 + c) * 16 + d
-      pure $ Text.pack [chr s]
-
-parseHexDigit :: AP.Parser Int
-parseHexDigit = label "hex digit" (digitToInt <$> CH.satisfy isHexDigit)
-
-parseCharInText :: Char -> AP.Parser ()
-parseCharInText a = parseLit a <|> escaped a
-  where
-    parseLit :: Char -> AP.Parser ()
-    parseLit = \case
-      '\\' -> void $ AP.string "\\\\"
-      '"' -> void $ AP.string "\\\""
-      '/' -> void $ AP.string "/" <|> AP.string "\\/"
-      '\b' -> void $ AP.string "\\b"
-      '\f' -> void $ AP.string "\\f"
-      '\n' -> void $ AP.string "\\n"
-      '\r' -> void $ AP.string "\\r"
-      '\t' -> void $ AP.string "\\t"
-      a -> if isControl a then empty else void $ AP.string $ encodeUtf8 $ Text.singleton a
-    escaped :: Char -> AP.Parser ()
-    escaped a = void $ AP.string $ encodeUtf8 $ Text.pack $ withEscaped $ (showHex $ ord a) []
-    withEscaped :: String -> String
-    withEscaped a@[_] = "\\u000" <> a
-    withEscaped a@[_,_] = "\\u00" <> a
-    withEscaped a@[_,_,_] = "\\u0" <> a
-    withEscaped r = "\\u" <> r
-
-objectKey :: Text.Text -> AP.Parser ()
-objectKey k = lexeme $ do
-  quotation
-  Text.foldr (\c a -> parseCharInText c *> a) (pure ()) k
-  quotation
-  pure ()
-
-startObject :: AP.Parser ()
-startObject
-  = label "object starting brace ('{')"
-  $ lexeme
-  $ void
-  $ AP.word8 123
-
-endObject :: AP.Parser ()
-endObject
-  = label "object ending brace ('}')"
-  $ lexeme
-  $ void
-  $ AP.word8 125
-
-inObjectBraces :: AP.Parser a -> AP.Parser a
-inObjectBraces interior = startObject *> interior <* endObject
-
-startArray :: AP.Parser ()
-startArray
-  = label "array starting brace ('[')"
-  $ lexeme
-  $ void
-  $ AP.word8 91
-
-endArray :: AP.Parser ()
-endArray
-  = label "array ending brace (']')"
-  $ lexeme
-  $ void
-  $ AP.word8 93
-
-labelSep :: AP.Parser ()
-labelSep = label "key-value separator (':')" $ void $ lexeme $ AP.string ":"
-
-anyDatum :: AP.Parser ()
-anyDatum = lexeme inner
-  where
-    inner
-      = runAttoparsecParser parseNull
-      <|> void (runAttoparsecParser parseBool)
-      <|> void (runAttoparsecParser parseText)
-      <|> void (runAttoparsecParser parseNumber)
-      <|> void (runAttoparsecParser parseBool)
-      <|> anyObject
-      <|> anyArray
-
-anyArray :: AP.Parser ()
-anyArray = label "ignored array" $ void $ do
-  startArray
-  anyDatum `AP.sepBy` comma
-  endArray
-
-number :: AP.Parser Scientific
-number = CH.scientific
-
-anyObject :: AP.Parser ()
-anyObject = label "ignored object" $ void $ do
-  startObject
-  flip AP.sepBy comma $ do
-    parseJSONText
-    labelSep
-    anyDatum
-  endObject
-
-parseObjectField
-  :: Text.Text
-  -> AP.Parser a
-  -> AP.Parser a
-parseObjectField t f = do
-  objectKey t
-  labelSep
-  lexeme f
+  pure = ParseNoEffect
+  f <*> a = case f of
+    ParseNoEffect fab -> case a of
+      ParseNoEffect a' -> ParseNoEffect (fab a')
+      ParseWithEffect pa -> ParseWithEffect (fab <$> pa)
+    ParseWithEffect pa -> case a of
+      ParseNoEffect a' -> ParseWithEffect (fmap ($ a') pa)
+      ParseWithEffect pa' -> ParseWithEffect $ do
+        f' <- pa
+        comma
+        f' <$> pa'
 
-parseDictField
-  :: AP.Parser a
-  -> AP.Parser (Text.Text, a)
-parseDictField p = do
-  key <- parseJSONText
-  labelSep
-  val <- p
-  pure (key, val)
+runArrayParser :: ArrayParser a -> AP.Parser a
+runArrayParser (ParseNoEffect a) = pure a
+runArrayParser (ParseWithEffect eff) = eff
 
 instance JSONObjectParser ObjectParser where
-  parseFieldWith label
-    = ObjectParser
-    . asPermutation
-    . parseObjectField label
-    . runAttoparsecParser
+  parseFieldWith label parser =
+    ObjectParser $
+      asPermutation $
+        parseObjectField
+          label
+          (runAttoparsecParser parser)
+  {-# INLINE parseFieldWith #-}
+  parseFieldWithDefault f = \(AttoparsecParser parseField) def ->
+    ObjectParser $
+      asPermutationWithDefault (parseObjectField f (parseField <?> ("field " <> show f))) def
 
-newtype AttoparsecParser a
-  = AttoparsecParser
-  { runAttoparsecParser :: AP.Parser a }
+newtype AttoparsecParser a = AttoparsecParser
+  {runAttoparsecParser :: AP.Parser a}
   deriving (Functor)
   deriving (Semigroup, Monoid) via (Alt AP.Parser a)
 
 instance JSONTupleParser ArrayParser where
-  consumeItemWith = ArrayParser . runAttoparsecParser
+  consumeItemWith = \parser -> ParseWithEffect $ runAttoparsecParser parser
 
 instance JSONParser AttoparsecParser where
-  parseObject _ p = AttoparsecParser $ inObjectBraces $ do
-    r <- wrapEffect parseAnyField comma $ runObjectParser p
-    label "junk object fields at the end of a parsed object" $ many junkFieldAtEnd
-    pure r
-  parseDictionary parse = AttoparsecParser $ inObjectBraces $ do
-    parseDictField (runAttoparsecParser parse) `AP.sepBy` comma
+  parseObject = \parser -> AttoparsecParser $
+    label "Object" $ do
+      startObject
+      r <- wrapEffect (parseAnyField <?> "ignored field in the middle of an object") comma $ runObjectParser parser
+      objectEndWithJunk
+      pure r
+  {-# INLINE parseObject #-}
+  parseDictionary parse = AttoparsecParser $
+    inObjectBraces $ do
+      parseDictField (runAttoparsecParser parse) `AP.sepBy` comma
   parseTextConstant c = AttoparsecParser (objectKey c <?> "text constant" <> Text.unpack c)
+  {-# INLINE parseTextConstant #-}
   parseText = AttoparsecParser parseJSONText
+  {-# INLINE parseText #-}
   parseNumber = AttoparsecParser number
+  {-# INLINE parseNumber #-}
   validateJSON v = AttoparsecParser $ do
     r <- runAttoparsecParser v
     case r of
@@ -281,27 +120,38 @@
     r <- runArrayParser ap
     lexeme $ AP.word8 93
     pure r
+  {-# INLINE parseTuple #-}
   parseArrayWith jp = AttoparsecParser $ do
     startArray
     r <- lexeme (runAttoparsecParser jp) `AP.sepBy` comma <?> "array items"
     endArray
     pure r
-  parseBool = AttoparsecParser $ lexeme $
-    (AP.string "true" $> True) <|> (AP.string "false" $> False)
+  {-# INLINE parseArrayWith #-}
+  parseBool =
+    AttoparsecParser $
+      lexeme $
+        (AP.string "true" $> True) <|> (AP.string "false" $> False)
   parseNull = AttoparsecParser $ lexeme (AP.string "null" $> ())
+  nameParser l = \(AttoparsecParser a) ->
+    AttoparsecParser $
+      label ("Parser '" <> Text.unpack l <> "'") a
 
 -- | Convert an abstract JSON parser to an Attoparsec Parser.
 -- This function will skip leading whitespace.
-convertParserToAttoparsecParser :: (forall parser. JSONParser parser => parser a) -> AP.Parser a
-convertParserToAttoparsecParser = (skipSpace *>) .  runAttoparsecParser
+attoparsecParserFor :: (forall parser. JSONParser parser => parser a) -> AP.Parser a
+attoparsecParserFor = \parser -> (skipSpace *>) $ runAttoparsecParser parser
+{-# INLINE attoparsecParserFor #-}
 
-runParserViaAttoparsec :: (forall parser. JSONParser parser => parser a) -> ByteString -> Either String a
-runParserViaAttoparsec p = AP.parseOnly (convertParserToAttoparsecParser p)
+parseViaAttoparsecWith :: (forall parser. JSONParser parser => parser a) -> ByteString -> Either String a
+parseViaAttoparsecWith p = AP.parseOnly (attoparsecParserFor p)
+{-# INLINE parseViaAttoparsecWith #-}
 
 -- | Parse a ByteString via an Attoparsec Parser.
-parseViaAttoparsec :: (FromJSON val) => ByteString -> Either String val
-parseViaAttoparsec = AP.parseOnly (skipSpace *> runAttoparsecParser fromJSON)
+parseViaAttoparsec :: forall val. (FromJSON val) => ByteString -> Either String val
+parseViaAttoparsec = parseViaAttoparsecWith (fromJSON @val)
+{-# INLINE parseViaAttoparsec #-}
 
 -- | Get an Attoparsec parser for a particular JSON-parsable value.
 attoparsecParser :: (FromJSON val) => AP.Parser val
 attoparsecParser = runAttoparsecParser fromJSON
+{-# INLINE attoparsecParser #-}
diff --git a/lib/Jordan/FromJSON/Class.hs b/lib/Jordan/FromJSON/Class.hs
--- a/lib/Jordan/FromJSON/Class.hs
+++ b/lib/Jordan/FromJSON/Class.hs
@@ -1,9 +1,11 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
@@ -11,133 +13,219 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
+
 -- | Parse JSON using finally-tagless style.
 --
 -- This provides JSON parsing as an abstract interface.
 -- This interface provides a way to parse JSON that is *inspectable*
 -- and has some nice properties: for example, we can use it to build a parser that
 -- directly parses your data structure, without building some intermediate value type!
-module Jordan.FromJSON.Class
-    where
+module Jordan.FromJSON.Class where
 
-import Control.Applicative (Alternative(..))
+import Control.Applicative (Alternative (..))
+import Data.Coerce
 import Data.Functor (($>))
+import qualified Data.Int as I
+import Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import qualified Data.Monoid as Monoid
-import Data.Proxy (Proxy(..))
+import Data.Proxy (Proxy (..))
 import qualified Data.Ratio as Ratio
 import Data.Scientific (Scientific)
 import qualified Data.Semigroup as Semigroup
 import qualified Data.Set as Set
 import qualified Data.Text as T
+import qualified Data.Text.Read as TR
 import Data.Typeable
 import GHC.Generics
+import GHC.TypeLits (KnownSymbol, symbolVal)
 import Jordan.Generic.Options
 
 -- | A class for parsing JSON objects.
-class (Applicative f) => JSONObjectParser f where
+class (Applicative f, Representational f) => JSONObjectParser f where
   -- | Parse an object field with a given label, using a parser.
   --
   -- Note: in order to enable the generation of better documentation, use 'parseField' instead if at all possible!
-  parseFieldWith
-    ::  T.Text
-    -- ^ Label of the field.
+  parseFieldWith ::
+    -- | Label of the field.
     -- Will be parsed into escaped text, if need be.
-    -> (forall valueParser. JSONParser valueParser => valueParser a)
-    -- ^ How to parse the field.
+    T.Text ->
+    -- | How to parse the field.
     -- Note the forall in this type signature: you cannot have this be specific to
     -- any particular implementation of parsing, to keep the parsing of a JSON abstract.
-    -> f a
-  parseField
-    :: (FromJSON v)
-    => T.Text
-    -> f v
+    (forall valueParser. JSONParser valueParser => valueParser a) ->
+    f a
+
+  parseDescribeFieldWith ::
+    -- | Field key to parse
+    T.Text ->
+    -- | Description of the field
+    T.Text ->
+    -- | Parser for the field
+    (forall valueParser. JSONParser valueParser => valueParser a) ->
+    f a
+  parseDescribeFieldWith field _ = parseFieldWith field
+  parseField ::
+    (FromJSON v) =>
+    T.Text ->
+    f v
   parseField t = parseFieldWith t fromJSON
+  {-# INLINE parseField #-}
+  parseDescribeField ::
+    (FromJSON v) =>
+    T.Text ->
+    T.Text ->
+    f v
+  parseDescribeField key desc = parseDescribeFieldWith key desc fromJSON
+  parseFieldWithDefault ::
+    -- | Label of the field.
+    T.Text ->
+    -- | Parse the value from the field
+    (forall valueParser. JSONParser valueParser => valueParser a) ->
+    -- | Default value for the field
+    a ->
+    -- | Field in the object.
+    f a
+  parseDescribeFieldWithDefault ::
+    -- | Label of the field
+    T.Text ->
+    -- | Description of the field
+    T.Text ->
+    -- | Parser for the field
+    (forall valueParser. JSONParser valueParser => valueParser a) ->
+    a ->
+    f a
+  parseDescribeFieldWithDefault field _ = parseFieldWithDefault field
 
 -- | A class for parsing JSON arrays.
-class (Applicative f) => JSONTupleParser f where
+class (Applicative f, Representational f) => JSONTupleParser f where
   -- | Use a JSON parser to consume a single item of an array, then move onto the next one.
   --
   -- Note: you should prefer 'consumeItem' as it enables better documentation generation.
-  consumeItemWith
-    :: (forall valueParser. JSONParser valueParser => valueParser a)
-    -> f a
+  consumeItemWith ::
+    (forall valueParser. JSONParser valueParser => valueParser a) ->
+    f a
+
   -- | Consume a single array item.
-  consumeItem
-    :: (FromJSON v)
-    => f v
+  consumeItem ::
+    (FromJSON v) =>
+    f v
   consumeItem = consumeItemWith fromJSON
 
 -- | Abstract class representing various parsers.
 --
 -- All parsers must have a Monoid instance that represents choice with failure as the identity.
-class (Functor f, forall a. Monoid (f a)) => JSONParser f where
-  parseObject
-    :: T.Text
-    -- ^ A label for the object.
-    -- This label should, as much as possible, be "globally unique" in some way.
-    -- This will enable better generation of documentation.
-    -> (forall objectParser. JSONObjectParser objectParser => objectParser a)
-    -- ^ Instructions on how to parse the object.
+class (Functor f, forall a. Semigroup (f a), Representational f) => JSONParser f where
+  parseObject ::
+    -- | Instructions on how to parse the object.
     -- Note that the actual implementation is kept abstract: you can only use methods found in JSONObjectParser, or
     -- combinators of those methods.
     -- This ensures that we can generate the proper parser in all cases.
-    -> f a
+    (forall objectParser. JSONObjectParser objectParser => objectParser a) ->
+    f a
+
   -- | Parse an object where you are okay if we parse strictly, IE, do not allow extra fields.
   -- This sometimes enables us to generate parsers that run faster.
-  parseObjectStrict
-    :: T.Text
-    -> (forall objectParser. JSONObjectParser objectParser => objectParser a)
-    -> f a
+  parseObjectStrict ::
+    (forall objectParser. JSONObjectParser objectParser => objectParser a) ->
+    f a
   parseObjectStrict = parseObject
+
   -- | Parse a dictionary of key-value pairs.
-  parseDictionary
-    :: (forall jsonParser. JSONParser jsonParser => jsonParser a)
-    -> f [(T.Text, a)]
+  parseDictionary ::
+    (forall jsonParser. JSONParser jsonParser => jsonParser a) ->
+    f [(T.Text, a)]
 
   -- | Parse a text field.
-  parseText
-    :: f T.Text
-  parseTextConstant
-    :: T.Text
-    -> f ()
+  parseText ::
+    f T.Text
+
+  parseTextConstant ::
+    T.Text ->
+    f ()
   parseTextConstant t = validateJSON (validated <$> parseText)
     where
       validated q
         | q == t = Right ()
         | otherwise = Left $ T.pack "Expected :" <> q
+
   -- | Use a tuple parser to parse an array.
-  parseTuple
-    :: (forall arrayParser. JSONTupleParser arrayParser => arrayParser o)
-    -> f o
-  parseArray
-    :: (FromJSON a)
-    => f [a]
+  parseTuple ::
+    (forall arrayParser. JSONTupleParser arrayParser => arrayParser o) ->
+    f o
+
+  parseArray ::
+    (FromJSON a) =>
+    f [a]
   parseArray = parseArrayWith fromJSON
-  parseArrayWith
-    :: (forall jsonParser. JSONParser jsonParser => jsonParser a)
-    -> f [a]
-  parseNumber
-    :: f Scientific
-  parseNull
-    :: f ()
-  parseBool
-    :: f Bool
-  validateJSON
-    :: f (Either T.Text a)
-    -> f a
+  parseArrayWith ::
+    (forall jsonParser. JSONParser jsonParser => jsonParser a) ->
+    f [a]
+  parseNumber ::
+    f Scientific
+  parseInteger ::
+    f Integer
+  parseInteger = round <$> parseNumber
+  parseNull ::
+    f ()
+  parseBool ::
+    f Bool
+  validateJSON ::
+    f (Either T.Text a) ->
+    f a
 
+  -- | Give a parser a unique name.
+  -- May be used for documentation.
+  nameParser ::
+    T.Text ->
+    f a ->
+    f a
+  nameParser _ a = a
+
+  -- | Add information about the format of a particular parser.
+  addFormat ::
+    T.Text ->
+    f a ->
+    f a
+  addFormat _ a = a
+
 -- | A class to provide the canonical way to parse a JSON.
 -- This class uses finally tagless tyle to keep the instructions for parsing abstract.
 -- This allows us to automatically generate documentation, and to generate parsers that do not use intermediate structures.
 --
 -- This class is derivable generically, and will generate a \"nice\" format.
 -- In my opinion, at least.
+--
+-- If you want to customize this JSON, the newtype 'WithOptions' can be helpful, as it allows you to specify options for the generic serialization.
+-- Unfortunately, due to a weird GHC quirk, you need to use it with @ -XStandaloneDeriving @ as well as @ -XDerivingVia @.
+-- That is, you should write:
+--
+--
+-- @
+-- data PersonFilter = PersonFilter { filterFirstName :: Maybe Text, filterLastName :: Maybe Text }
+--   deriving (Show, Read, Eq, Ord, Generic)
+--
+-- deriving via (WithOptions '[KeepNothingFields] PersonFilter) instance (FromJSON PersonFilter)
+-- @
+--
+-- === __Laws__
+--
+-- This instance is lawless, unless 'Jordan.ToJSON.Class.ToJSON' is also defined for this type.
+-- In that case, the representation parsed by 'FromJSON' should match that of the representation serialized by
+-- 'Jordan.ToJSON.Class.ToJSON'.
 class FromJSON value where
   fromJSON :: (JSONParser f) => f value
-  default fromJSON :: (Generic value, GFromJSON (Rep value)) => (JSONParser f => f value)
-  fromJSON = to <$> gFromJSON @(Rep value) defaultOptions
+  {-# INLINE fromJSON #-}
+  default fromJSON :: (Generic value, GFromJSON (Rep value), Typeable value) => (JSONParser f => f value)
+  fromJSON = to <$> gFromJSON @(Rep value) defaultOptions {fromJSONBaseName = bn}
+    where
+      bn = T.unpack $ fullyQualifyName $ typeRep (Proxy :: Proxy value)
 
+instance (Generic a, GFromJSON (Rep a), Typeable a, SpecifiesFromJSONOptions options) => FromJSON (WithOptions options a) where
+  fromJSON = WithOptions . to <$> gFromJSON @(Rep a) (specifiedFromJSONOptions @options) {fromJSONBaseName = bn}
+    where
+      bn = T.unpack $ fullyQualifyName $ typeRep (Proxy :: Proxy a)
+
 instance FromJSON () where
   fromJSON = parseNull
 
@@ -148,7 +236,7 @@
   fromJSON = T.unpack <$> parseText
 
 instance (FromJSON a) => FromJSON (Maybe a) where
-  fromJSON = (Nothing <$ parseNull) <> (Just <$> fromJSON)
+  fromJSON = (Just <$> fromJSON) <> (parseNull $> Nothing)
 
 -- | Right-biased: will try to parse a 'Right' value first.
 instance (FromJSON l, FromJSON r) => FromJSON (Either l r) where
@@ -161,26 +249,32 @@
   fromJSON = parseText
 
 instance FromJSON Int where
-  fromJSON = fmap round parseNumber
+  fromJSON = fromInteger <$> parseInteger
 
 instance FromJSON Float where
-  fromJSON = realToFrac <$> parseNumber
+  fromJSON = addFormat "float" $ realToFrac <$> parseNumber
 
 instance FromJSON Double where
-  fromJSON = realToFrac <$> parseNumber
+  fromJSON = addFormat "double" $ realToFrac <$> parseNumber
 
+instance FromJSON I.Int32 where
+  fromJSON = addFormat "int32" $ fromInteger <$> parseInteger
+
+instance FromJSON I.Int64 where
+  fromJSON = addFormat "int64" $ fromInteger <$> parseInteger
+
 instance FromJSON Integer where
-  fromJSON = fmap round parseNumber
+  fromJSON = parseInteger
 
 instance FromJSON Scientific where
   fromJSON = parseNumber
 
-instance forall a. (Integral a, FromJSON a, Typeable a) => FromJSON (Ratio.Ratio a) where
-  fromJSON = parseObject objName $
-    (Ratio.%) <$> parseField "num" <*> parseField "denom"
-      where
-        objName = T.pack $ tyName <> ".Ratio"
-        tyName = (tyConModule <> const "." <> tyConName) $ typeRepTyCon $ typeRep (Proxy :: Proxy a)
+instance forall a. (Integral a, FromJSON a) => FromJSON (Ratio.Ratio a) where
+  fromJSON =
+    parseObject $
+      (Ratio.%)
+        <$> parseDescribeField "num" "numerator of the ratio"
+        <*> parseDescribeField "denom" "denominator of the ratio"
 
 instance FromJSON a => FromJSON (Monoid.Dual a) where
   fromJSON = Monoid.Dual <$> fromJSON
@@ -228,95 +322,162 @@
 instance FromJSON a => FromJSON (Map.Map T.Text a) where
   fromJSON = foldMap (uncurry Map.singleton) <$> parseDictionary fromJSON
 
-data FromJSONOptions
-  = FromJSONOptions
-  { fromJSONEncodeSums :: SumTypeEncoding
-  , fromJSONBaseName :: String
-  , convertEnum :: String -> String
+instance FromJSON a => FromJSON (Map.Map Integer a) where
+  fromJSON = foldMap toSingleDict <$> parseDictionary fromJSON
+    where
+      toSingleDict (k, v) = case TR.signed TR.decimal k of
+        Left s -> mempty
+        Right (i, rest) -> if rest == mempty then Map.singleton i v else mempty
+
+instance (FromJSON a) => FromJSON (NE.NonEmpty a) where
+  fromJSON = validateJSON $ fmap toNonEmpty parseArray
+    where
+      toNonEmpty a = case NE.nonEmpty a of
+        Nothing -> Left "Empty list"
+        Just a -> pure a
+
+data FromJSONOptions = FromJSONOptions
+  { fromJSONEncodeSums :: SumTypeEncoding,
+    fromJSONBaseName :: String,
+    convertEnum :: String -> String,
+    fromJSONOmitNothingFields :: Bool
   }
   deriving (Generic)
 
 defaultOptions :: FromJSONOptions
-defaultOptions = FromJSONOptions TagInField "" id
+defaultOptions = FromJSONOptions TagInField "" id True
 
+class SpecifiesFromJSONOptions (a :: [*]) where
+  specifiedFromJSONOptions :: FromJSONOptions
+
+instance SpecifiesFromJSONOptions '[] where
+  specifiedFromJSONOptions = defaultOptions
+
+instance
+  (SpecifiesFromJSONOptions xs) =>
+  SpecifiesFromJSONOptions (OmitNothingFields ': xs)
+  where
+  specifiedFromJSONOptions = (specifiedFromJSONOptions @xs) {fromJSONOmitNothingFields = True}
+
+instance
+  (SpecifiesFromJSONOptions xs) =>
+  SpecifiesFromJSONOptions (KeepNothingFields ': xs)
+  where
+  specifiedFromJSONOptions =
+    (specifiedFromJSONOptions @xs) {fromJSONOmitNothingFields = False}
+
 addName :: String -> FromJSONOptions -> FromJSONOptions
-addName s d = d { fromJSONBaseName = fromJSONBaseName d <> s }
+addName s d = d {fromJSONBaseName = fromJSONBaseName d <> s}
 
 class GFromJSON v where
   gFromJSON :: (JSONParser f) => FromJSONOptions -> f (v a)
 
+-- | Top-level metadata is ignored.
 instance (FromJSON c) => GFromJSON (K1 i c) where
   gFromJSON _ = K1 <$> fromJSON
 
+-- | Datatype metadata: we name the overall datatype with the baseName
+-- provided in the options, then serialize the inner information.
 instance (GFromJSON f, Datatype t) => GFromJSON (D1 t f) where
-  gFromJSON opts = M1 <$> gFromJSON (addName name opts)
-    where
-      name = moduleName s <> "." <> datatypeName s
-      s :: D1 t f a
-      s = undefined
+  gFromJSON opts = nameParser (T.pack (fromJSONBaseName opts)) $ M1 <$> gFromJSON opts
 
-instance {-# OVERLAPPABLE #-} forall c i. (GFromJSONObject i, Constructor c) => GFromJSON (C1 c i) where
-  gFromJSON opts = M1 <$> parseObject (T.pack name) (gFromJSONObject opts)
+-- | If we have a constructor with arguments, and those arguments
+-- do not have selectors (IE, this is not a record), then we should parse as a tuple.
+instance
+  {-# OVERLAPPABLE #-}
+  (GFromJSONTuple inner, KnownSymbol n) =>
+  GFromJSON (C1 (MetaCons n s 'False) inner)
+  where
+  gFromJSON opts = nameParser objName $ M1 <$> parseTuple (gFromJSONTuple opts)
     where
-      name = fromJSONBaseName opts <> "." <> conName n
-      n :: C1 c i a
-      n = undefined
-
-instance {-# OVERLAPS #-} (FromJSON s) => GFromJSON (C1 c (S1 (MetaSel 'Nothing su ss ds) (Rec0 s))) where
-  gFromJSON _ = M1 . M1 . K1 <$> fromJSON
-
-instance GFromJSON U1 where
-  gFromJSON opts = U1 <$ parseNull
+      objName = T.pack (fromJSONBaseName opts) <> "." <> conName
+      conName = T.pack $ symbolVal (Proxy :: Proxy n)
 
-instance {-# OVERLAPS #-} (Constructor t) => GFromJSON (C1 t U1) where
-  gFromJSON opts = M1 U1 <$ parseTextConstant conn
+-- | If we have a constructor with arguments, and those arguments
+-- do have selectors (IE, this is a record), then we should parse as a record.
+instance {-# OVERLAPS #-} forall c i n s. (GFromJSONObject i, KnownSymbol n) => GFromJSON (C1 (MetaCons n s 'True) i) where
+  gFromJSON opts = M1 <$> nameParser (T.pack name) (parseObject $ gFromJSONObject opts)
     where
-      conn = T.pack $ conName c
-      c :: C1 t U1 f
-      c = undefined
+      name = fromJSONBaseName opts <> "." <> symbolVal (Proxy @n)
 
-instance {-# OVERLAPS #-} (Constructor t) => GFromJSON (PartOfSum (C1 t U1)) where
-  gFromJSON opts = PartOfSum (M1 U1) <$ parseTextConstant enumValue
+-- | Special-case: a one-argument constructor with no field selector gets its own parser, skipping the tuple entirely.
+instance {-# OVERLAPS #-} (FromJSON inner, KnownSymbol n) => GFromJSON (C1 (MetaCons n s 'False) (S1 (MetaSel Nothing ss su dl) (Rec0 inner))) where
+  gFromJSON opts =
+    M1 . M1 . K1
+      <$> fromJSON
     where
-      enumValue = T.pack $ convertEnum opts $ conName (undefined :: C1 t U1 f)
+      connName = T.pack $ symbolVal $ Proxy @n
 
-instance {-# OVERLAPPING #-} (GFromJSON (C1 t f), Constructor t) => GFromJSON (PartOfSum (C1 t f)) where
-  gFromJSON opts  = PartOfSum <$> encoded
+-- | When rendering a sum type, if we have a more complex value (IE, maybe
+-- this is a constructor that takes arguments), we want to use whatever
+-- sum encoding was provided in the options.
+instance {-# OVERLAPPABLE #-} (GFromJSON (C1 t f), Constructor t) => GFromJSON (PartOfSum (C1 t f)) where
+  gFromJSON opts = MkPartOfSum <$> encoded
     where
       encoded = case fromJSONEncodeSums opts of
         TagVal -> tagged
         TagInField -> field
-      tagged = parseObject (objName name) $
-        parseFieldWith "tag" (parseTextConstant name)
-        *> parseFieldWith "val" (gFromJSON opts)
-      field = parseObject (objName name) $
-        parseFieldWith name (gFromJSON opts)
+      tagged =
+        parseObject $
+          parseFieldWith "tag" (parseTextConstant name)
+            *> parseFieldWith "val" (gFromJSON opts)
+      field =
+        parseObject $
+          parseFieldWith name (gFromJSON opts)
       name = T.pack $ conName (undefined :: C1 t f a)
-      objName a = T.pack (fromJSONBaseName opts <> ".") <> a <> ".Input"
+      objName = T.pack (fromJSONBaseName opts <> ".") <> name
 
+instance {-# OVERLAPPABLE #-} (KnownSymbol connName) => GFromJSON (C1 (MetaCons connName dontCare 'False) U1) where
+  gFromJSON _ = M1 U1 <$ parseTextConstant constName
+    where
+      constName = T.pack (symbolVal $ Proxy @connName)
+
+instance {-# OVERLAPS #-} (KnownSymbol connName) => GFromJSON (PartOfSum (C1 (MetaCons connName dontCare 'False) U1)) where
+  gFromJSON opts = MkPartOfSum <$> gFromJSON opts
+
+-- | If we can parse both sides of a sum-type, we can parse the entire sum type.
 instance {-# OVERLAPS #-} (GFromJSON (PartOfSum l), GFromJSON (PartOfSum r)) => GFromJSON (l :+: r) where
   gFromJSON opts =
     (L1 . getPartOfSum <$> gFromJSON opts) <> (R1 . getPartOfSum <$> gFromJSON opts)
 
-instance (GFromJSON (PartOfSum l), GFromJSON (PartOfSum r)) => GFromJSON (PartOfSum (l :+: r)) where
-  gFromJSON opts = PartOfSum <$> gFromJSON opts
-
-instance {-# OVERLAPPING #-} (Constructor t, Constructor t') =>
-  GFromJSON (C1 t U1 :+: C1 t' U1) where
-    gFromJSON ops = (L1 <$> gFromJSON ops) <> (R1 <$> gFromJSON ops)
+instance {-# OVERLAPS #-} (GFromJSON (PartOfSum l), GFromJSON (PartOfSum r)) => GFromJSON (PartOfSum (l :+: r)) where
+  gFromJSON opts =
+    MkPartOfSum
+      <$> (L1 . getPartOfSum <$> gFromJSON opts) <> (R1 . getPartOfSum <$> gFromJSON opts)
 
+-- | Class that helps us parse JSON objects.
 class GFromJSONObject v where
   gFromJSONObject :: (JSONObjectParser f) => FromJSONOptions -> f (v a)
 
 instance GFromJSONObject U1 where
   gFromJSONObject _ = pure U1
 
-instance (FromJSON c, Selector t) => GFromJSONObject (S1 t (K1 v c)) where
-  gFromJSONObject o
-    = M1 . K1 <$> parseField (T.pack $ selName v)
-      where
-        v :: M1 S t f a
-        v = undefined
+instance {-# OVERLAPPABLE #-} (FromJSON c, Selector t) => GFromJSONObject (S1 t (K1 v c)) where
+  gFromJSONObject o =
+    M1 . K1 <$> parseField (T.pack $ selName v)
+    where
+      v :: M1 S t f a
+      v = undefined
 
+instance {-# OVERLAPS #-} (FromJSON c, Selector t) => GFromJSONObject (S1 t (K1 v (Maybe c))) where
+  gFromJSONObject o =
+    M1 . K1 <$> parse
+    where
+      parse
+        | fromJSONOmitNothingFields o = parseFieldWithDefault field ((Just <$> fromJSON) <> (parseNull $> Nothing)) Nothing
+        | otherwise = parseField field
+      field = T.pack $ selName v
+      v :: M1 S t f a
+      v = undefined
+
 instance (GFromJSONObject lhs, GFromJSONObject rhs) => GFromJSONObject (lhs :*: rhs) where
   gFromJSONObject o = (:*:) <$> gFromJSONObject o <*> gFromJSONObject o
+
+class GFromJSONTuple v where
+  gFromJSONTuple :: (JSONTupleParser f) => FromJSONOptions -> f (v a)
+
+instance (GFromJSONTuple lhs, GFromJSONTuple rhs) => GFromJSONTuple (lhs :*: rhs) where
+  gFromJSONTuple o = (:*:) <$> gFromJSONTuple o <*> gFromJSONTuple o
+
+instance (GFromJSON f) => GFromJSONTuple (S1 (MetaSel Nothing su ss ds) f) where
+  gFromJSONTuple o = M1 <$> consumeItemWith (gFromJSON o)
diff --git a/lib/Jordan/FromJSON/Internal/Attoparsec.hs b/lib/Jordan/FromJSON/Internal/Attoparsec.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/FromJSON/Internal/Attoparsec.hs
@@ -0,0 +1,431 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Jordan.FromJSON.Internal.Attoparsec where
+
+import Control.Applicative (Alternative (..))
+import Control.Monad (void, when)
+import Data.Attoparsec.ByteString ((<?>))
+import qualified Data.Attoparsec.ByteString as A
+import qualified Data.Attoparsec.ByteString as AP
+import qualified Data.Attoparsec.ByteString.Char8 as CH
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Unsafe as B
+import Data.Char (chr, digitToInt, isControl, isHexDigit, ord)
+import Data.Functor (void, ($>))
+import Data.Monoid (Alt (..))
+import Data.Scientific (Scientific)
+import qualified Data.Scientific as Sci
+import qualified Data.Scientific as Scientific
+import qualified Data.Text as Text
+import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Numeric (showHex)
+
+skipSpace :: AP.Parser ()
+skipSpace = AP.skipWhile isSpace <?> "skipped space"
+  where
+    isSpace = \case
+      32 -> True
+      10 -> True
+      13 -> True
+      9 -> True
+      _ -> False
+
+lexeme :: AP.Parser a -> AP.Parser a
+lexeme a = a <* skipSpace
+
+label :: String -> AP.Parser a -> AP.Parser a
+label l p = p <?> l
+
+parseAnyField :: AP.Parser ()
+parseAnyField =
+  {-# SCC ignoredObjectField #-}
+  label "ignored object field" $
+    void $ do
+      lexeme parseJunkText
+      labelSep
+      anyDatum
+
+objectEndWithJunk :: AP.Parser ()
+objectEndWithJunk = endObject <|> junkFieldAndEnd
+  where
+    junkFieldAndEnd = void $ do
+      comma
+      label "ignored extra field at object end" parseAnyField
+      objectEndWithJunk
+
+comma :: AP.Parser ()
+comma = label "comma character" $ void $ lexeme (AP.string ",")
+
+quotation :: AP.Parser ()
+quotation = label "quotation mark" $ void $ AP.word8 34
+
+parseJSONText :: AP.Parser Text.Text
+parseJSONText = label "JSON text" $ do
+  quotation
+  innerText
+
+-- | A parser for a JSON text value that skips its input.
+-- Avoids doing UTF-8 Decoding.
+parseJunkText :: AP.Parser ()
+parseJunkText = label "Ignored JSON Text Literal" $ do
+  quotation
+  junkInnerText
+{-# INLINE parseJunkText #-}
+
+-- | Parses the bit of a JSON string after the quotation.
+innerText :: AP.Parser Text.Text
+innerText = do
+  chunk <- label "Skipped text body" $
+    AP.takeWhile $ \char -> char /= 92 && char /= 34
+  l <- AP.peekWord8
+  case l of
+    Nothing -> fail "string without end"
+    Just 34 -> do
+      AP.anyWord8
+      pure $ decodeUtf8 chunk
+    Just 92 -> do
+      AP.anyWord8
+      r <- label "escape value" parseEscape
+      rest <- innerText
+      pure $ decodeUtf8 chunk <> r <> rest
+    Just _ -> fail "Impossibe: Parsed until we parsed a '\\' or a '\"', yet next char was neither"
+
+junkInnerText :: AP.Parser ()
+junkInnerText =
+  {-# SCC ignoredTextBetweenQuotes #-}
+  do
+    AP.skipWhile $ \char -> char /= 92 && char /= 34
+    !l <- AP.peekWord8
+    case l of
+      Nothing -> fail "string without end"
+      Just 34 -> AP.anyWord8 $> ()
+      Just 93 -> do
+        AP.anyWord8
+        parseEscape
+        -- Yes we could save a miniscule amount of time by replacing this with an "ignoring" version.
+        -- However, laziness means that we probably don't save *that* much.
+        junkInnerText
+      Just _ -> fail "Impossible: Skipped until we parsed a '\\' or a '\"', yet next char was neither"
+{-# INLINE junkInnerText #-}
+
+parseEscape :: AP.Parser Text.Text
+parseEscape =
+  quote
+    <|> backslash
+    <|> solidus
+    <|> backspace
+    <|> formfeed
+    <|> linefeed
+    <|> carriage
+    <|> tab
+    <|> escaped
+  where
+    backslash = AP.string "\\" $> "\\" <?> "Backslash escape"
+    quote = AP.string "\"" $> "\"" <?> "Quote escape"
+    solidus = AP.string "/" $> "/" <?> "Solidus escape"
+    backspace = AP.string "b" $> "\b" <?> "Backspace escape"
+    formfeed = AP.string "f" $> "\f" <?> "Formfeed escape"
+    linefeed = AP.string "n" $> "\n" <?> "Linefeed escape"
+    carriage = AP.string "r" $> "\r" <?> "Carriage escape"
+    tab = AP.string "t" $> "\t" <?> "Tab escape"
+    escaped = label "UTF Code Escape" $ do
+      AP.string "u"
+      a <- parseHexDigit
+      b <- parseHexDigit
+      c <- parseHexDigit
+      d <- parseHexDigit
+      let s = (((a * 16) + b) * 16 + c) * 16 + d
+      pure $ Text.pack [chr s]
+
+parseHexDigit :: AP.Parser Int
+parseHexDigit = label "hex digit" (digitToInt <$> CH.satisfy isHexDigit)
+
+parseCharInText :: Char -> AP.Parser ()
+parseCharInText a = parseLit a <|> escaped a
+  where
+    parseLit :: Char -> AP.Parser ()
+    parseLit = \case
+      '\\' -> void $ AP.string "\\\\"
+      '"' -> void $ AP.string "\\\""
+      '/' -> void $ AP.string "/" <|> AP.string "\\/"
+      '\b' -> void $ AP.string "\\b"
+      '\f' -> void $ AP.string "\\f"
+      '\n' -> void $ AP.string "\\n"
+      '\r' -> void $ AP.string "\\r"
+      '\t' -> void $ AP.string "\\t"
+      a -> if isControl a then empty else void $ AP.string $ encodeUtf8 $ Text.singleton a
+    escaped :: Char -> AP.Parser ()
+    escaped a = void $ AP.string $ encodeUtf8 $ Text.pack $ withEscaped $ (showHex $ ord a) []
+    withEscaped :: String -> String
+    withEscaped a@[_] = "\\u000" <> a
+    withEscaped a@[_, _] = "\\u00" <> a
+    withEscaped a@[_, _, _] = "\\u0" <> a
+    withEscaped r = "\\u" <> r
+
+mustBeEscaped :: Char -> Bool
+mustBeEscaped = \case
+  '\\' -> True
+  '"' -> True
+  '/' -> True
+  '\b' -> True
+  '\f' -> True
+  '\n' -> True
+  '\r' -> True
+  '\t' -> True
+  _ -> False
+
+canParseDirectly :: Text.Text -> Bool
+canParseDirectly t = not $ Text.foldr (\c v -> v || mustBeEscaped c) False t
+
+parseTextBody :: Text.Text -> AP.Parser ()
+parseTextBody text
+  | canParseDirectly text = void (A.string (encodeUtf8 text)) <|> parseViaChars text
+  | otherwise = parseViaChars text
+
+parseViaChars = Text.foldr (\c a -> parseCharInText c *> a) (pure ())
+
+objectKey :: Text.Text -> AP.Parser ()
+objectKey k = lexeme $ do
+  quotation
+  {-# SCC "knownObjectKeyBetweenQuotes" #-} parseTextBody k
+  quotation
+  pure ()
+
+startObject :: AP.Parser ()
+startObject =
+  label "object starting brace ('{')" $
+    lexeme $
+      void $
+        AP.word8 123
+
+endObject :: AP.Parser ()
+endObject =
+  label "object ending brace ('}')" $
+    lexeme $
+      void $
+        AP.word8 125
+
+inObjectBraces :: AP.Parser a -> AP.Parser a
+inObjectBraces interior = startObject *> interior <* endObject
+
+startArray :: AP.Parser ()
+startArray =
+  label "array starting brace ('[')" $
+    lexeme $
+      void $
+        AP.word8 91
+
+endArray :: AP.Parser ()
+endArray =
+  label "array ending brace (']')" $
+    lexeme $
+      void $
+        AP.word8 93
+
+labelSep :: AP.Parser ()
+labelSep = label "key-value separator (':')" $ void $ lexeme $ AP.string ":"
+
+anyDatum :: AP.Parser ()
+anyDatum =
+  lexeme $
+    {-# SCC "ignoredJSONValue" #-}
+    do
+      t <- AP.peekWord8
+      case t of
+        Just 102 -> void $ AP.string "false"
+        Just 110 -> void $ AP.string "null"
+        Just 116 -> void $ AP.string "true"
+        Just 123 -> anyObject
+        Just 34 -> parseJunkText
+        Just 43 -> parseJunkNumber
+        Just 45 -> parseJunkNumber
+        Just 48 -> parseJunkNumber
+        Just 49 -> parseJunkNumber
+        Just 50 -> parseJunkNumber
+        Just 51 -> parseJunkNumber
+        Just 52 -> parseJunkNumber
+        Just 53 -> parseJunkNumber
+        Just 54 -> parseJunkNumber
+        Just 55 -> parseJunkNumber
+        Just 57 -> parseJunkNumber
+        Just 59 -> parseJunkNumber
+        Just 91 -> anyArray
+        Just _ -> fail "not a valid starter of any JSON value"
+        Nothing -> fail "empty input"
+{-# INLINE anyDatum #-}
+
+anyArray :: AP.Parser ()
+anyArray = label "ignored array" $
+  void $ do
+    startArray
+    endArray <|> junkItems
+  where
+    junkItems = do
+      anyDatum
+      endArray <|> (comma *> junkItems)
+
+parseJunkDecimalZero :: AP.Parser ()
+parseJunkDecimalZero = do
+  let zero = 48
+  digits <- A.takeWhile1 CH.isDigit_w8
+  when (B.length digits > 1 && B.unsafeHead digits == zero) $
+    fail "leading zero"
+
+parseJunkExponent :: AP.Parser ()
+parseJunkExponent = label "junk exponent" $ do
+  A.satisfy (\ex -> ex == 101 || ex == 69)
+  A.skipWhile (\ch -> ch == 45 || ch == 43)
+  parseJunkDecimalZero
+
+parseJunkNumber :: AP.Parser ()
+parseJunkNumber = do
+  A.skipWhile (\ch -> ch == 45 || ch == 43)
+  parseJunkDecimalZero
+  -- skip decimal
+  dot <- A.peekWord8
+  case dot of
+    Just 46 -> void $ A.anyWord8 *> A.takeWhile1 CH.isDigit_w8
+    _ -> pure ()
+  parseJunkExponent <|> pure ()
+
+------ Scientific parser, copy/pasted from Aeson. ----
+
+-- (This parser was in turn copy-pasted itself from various soruces so this is kohser)
+
+-- A strict pair
+data SP = SP !Integer {-# UNPACK #-} !Int
+
+decimal0 :: AP.Parser Integer
+decimal0 = do
+  let zero = 48
+  digits <- A.takeWhile1 CH.isDigit_w8
+  if B.length digits > 1 && B.unsafeHead digits == zero
+    then fail "leading zero"
+    else return (bsToInteger digits)
+
+-- | Parse a JSON number.
+--
+-- This function is wholesale copy/pasted from Aeson.
+-- Thanks to them.
+scientific :: AP.Parser Scientific
+scientific = do
+  let minus = 45
+      plus = 43
+  sign <- A.peekWord8'
+  let !positive = sign == plus || sign /= minus
+  when (sign == plus || sign == minus) $
+    void A.anyWord8
+
+  n <- decimal0
+
+  let f fracDigits =
+        SP
+          (B.foldl' step n fracDigits)
+          (negate $ B.length fracDigits)
+      step a w = a * 10 + fromIntegral (w - 48)
+
+  dotty <- A.peekWord8
+  -- '.' -> ascii 46
+  SP c e <- case dotty of
+    Just 46 -> A.anyWord8 *> (f <$> A.takeWhile1 CH.isDigit_w8)
+    _ -> pure (SP n 0)
+
+  let !signedCoeff
+        | positive = c
+        | otherwise = - c
+
+  let littleE = 101
+      bigE = 69
+  ( A.satisfy (\ex -> ex == littleE || ex == bigE)
+      *> fmap (Scientific.scientific signedCoeff . (e +)) (CH.signed CH.decimal)
+    )
+    <|> return (Scientific.scientific signedCoeff e)
+{-# INLINE scientific #-}
+
+bsToInteger :: B.ByteString -> Integer
+bsToInteger bs
+  | l > 40 = valInteger 10 l [fromIntegral (w - 48) | w <- B.unpack bs]
+  | otherwise = bsToIntegerSimple bs
+  where
+    l = B.length bs
+
+bsToIntegerSimple :: B.ByteString -> Integer
+bsToIntegerSimple = B.foldl' step 0
+  where
+    step a b = a * 10 + fromIntegral (b - 48) -- 48 = '0'
+
+-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b
+-- digits are combined into a single radix b^2 digit. This process is
+-- repeated until we are left with a single digit. This algorithm
+-- performs well only on large inputs, so we use the simple algorithm
+-- for smaller inputs.
+valInteger :: Integer -> Int -> [Integer] -> Integer
+valInteger = go
+  where
+    go :: Integer -> Int -> [Integer] -> Integer
+    go _ _ [] = 0
+    go _ _ [d] = d
+    go b l ds
+      | l > 40 = b' `seq` go b' l' (combine b ds')
+      | otherwise = valSimple b ds
+      where
+        -- ensure that we have an even number of digits
+        -- before we call combine:
+        ds' = if even l then ds else 0 : ds
+        b' = b * b
+        l' = (l + 1) `quot` 2
+
+    combine b (d1 : d2 : ds) = d `seq` (d : combine b ds)
+      where
+        d = d1 * b + d2
+    combine _ [] = []
+    combine _ [_] = errorWithoutStackTrace "this should not happen"
+
+-- The following algorithm is only linear for types whose Num operations
+-- are in constant time.
+valSimple :: Integer -> [Integer] -> Integer
+valSimple base = go 0
+  where
+    go r [] = r
+    go r (d : ds) = r' `seq` go r' ds
+      where
+        r' = r * base + fromIntegral d
+
+number :: AP.Parser Scientific
+number = scientific
+{-# INLINE number #-}
+
+anyObject :: AP.Parser ()
+anyObject =
+  {-# SCC ignoredJSONObject #-}
+  label "ignored object" $
+    void $ do
+      startObject
+      endObject <|> junkField
+  where
+    junkField = do
+      parseAnyField
+      endObject <|> (comma *> junkField)
+
+parseObjectField ::
+  Text.Text ->
+  AP.Parser a ->
+  AP.Parser a
+parseObjectField t f = do
+  objectKey t
+  labelSep
+  lexeme f
+
+parseDictField ::
+  AP.Parser a ->
+  AP.Parser (Text.Text, a)
+parseDictField p = do
+  key <- lexeme parseJSONText
+  labelSep
+  val <- p
+  pure (key, val)
diff --git a/lib/Jordan/FromJSON/Internal/Permutation.hs b/lib/Jordan/FromJSON/Internal/Permutation.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/FromJSON/Internal/Permutation.hs
@@ -0,0 +1,153 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RoleAnnotations #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TupleSections #-}
+
+-- | Module containing internal helpers for our parsers.
+module Jordan.FromJSON.Internal.Permutation where
+
+import Control.Applicative (Alternative (..))
+import Control.Monad (void, when)
+import Data.Bifunctor
+import Data.Foldable (asum)
+import Data.Functor.Compose
+import qualified Data.Map.Lazy as Map
+import Data.Maybe (fromMaybe, isJust)
+import Debug.Trace
+
+data FailingParser parser
+  = FailingParser (forall a. parser a)
+  | NoFailingParser
+
+instance (Applicative parser) => Semigroup (FailingParser parser) where
+  (FailingParser a) <> (FailingParser b) = FailingParser (a *> b)
+  (FailingParser a) <> NoFailingParser = FailingParser a
+  NoFailingParser <> (FailingParser a) = FailingParser a
+  NoFailingParser <> NoFailingParser = NoFailingParser
+
+eliminateFailing :: (Alternative parser) => FailingParser parser -> parser a
+eliminateFailing (FailingParser f) = f
+eliminateFailing NoFailingParser = empty
+
+type role Permutation nominal representational
+
+-- | A parser for permutations.
+--
+-- Based on the paper Parsing Permutation Phrases by
+-- Arthur Baars, Andres Loh, and S. Doaitse Swierstra.
+--
+-- The source code for 'Control.Applicative.Permutations' really helped
+-- in writing this, although this type is structured differently (and closer to the actual paper).
+-- Thank you very much to Alex Washburn!
+data Permutation parser a
+  = Permutation !(Maybe a) !(FailingParser parser) [Branch parser a]
+
+type role Branch nominal representational
+
+-- | A branch of a permutation.
+-- Permutation parsers work by building up the entire tree of
+-- possible parsers, which is efficient in Haskell due to laziness.
+data Branch parser a
+  = forall arg. Branch (Permutation parser (arg -> a)) (parser arg)
+
+instance (Functor m) => Functor (Branch m) where
+  fmap f (Branch perm p) = Branch (fmap (f .) perm) p
+
+instance (Functor m) => Functor (Permutation m) where
+  fmap f (Permutation def failing branches) =
+    Permutation (f <$> def) failing (fmap f <$> branches)
+
+instance (Alternative m) => Applicative (Branch m) where
+  pure a = Branch (pure $ const a) (pure ())
+  (Branch permuteF argF) <*> (Branch permuteA argA) =
+    Branch (args <$> permuteF <*> permuteA) arguments
+    where
+      arguments = ((,) <$> argA <*> argF) <|> (flip (,) <$> argF <*> argA)
+      args :: (arg1 -> a -> b) -> (arg2 -> a) -> (arg2, arg1) -> b
+      args f a (aa, fa) = f fa (a aa)
+
+instance (Alternative m) => Applicative (Permutation m) where
+  pure val = Permutation (Just val) NoFailingParser empty
+
+  t1@(Permutation defF failingF choiceF) <*> t2@(Permutation defA failingA choiceA) =
+    Permutation (defF <*> defA) NoFailingParser (map ins2 choiceF ++ map ins1 choiceA)
+    where
+      ins1 (Branch perm p) = Branch ((.) <$> t1 <*> perm) p
+      ins2 (Branch perm p) = Branch (flip <$> perm <*> t2) p
+
+-- | Wrap up a permutation parser with two effects:
+--
+-- It will first interleave an infinite number of some effects, which represent parsing "junk" or unwanted fields.
+-- At every stage of the permutation, we will first try to run the effect we want, and if it fails
+-- we will try to run the "junk" effect instead, then try again.
+--
+-- We attempt to *intersperse* the second effect afterwards.
+-- It adds a new effect between every effect.
+-- This is used in parsing JSON to add commas.
+wrapEffect ::
+  forall m a b.
+  (Alternative m) =>
+  -- | Consume a single, \"junk\" field.
+  -- Used to ignore JSON keys that we do not care about.
+  m b ->
+  -- | Consume a \"separator\" between items in the permutation.
+  -- This consumption is not done at the front of the permutation
+  -- or after the end of it.
+  -- This is used to parse commas between JSON fields.
+  m b ->
+  -- | The permutation parser to run.
+  Permutation m a ->
+  -- | The final parser.
+  m a
+wrapEffect takeSingle effAfter (Permutation def failing choices) = consumeMany
+  where
+    consumeMany =
+      foldr ((<|>) . pars) empty choices
+        -- Base case above: one of the choices of the permutation matched
+        <|> (takeSingle *> effAfter *> consumeMany)
+        <|> maybe empty pure def
+
+    -- Interleaving case: none of the choices of the permutation matched,
+    -- so run a "junk" effect, the separator, and try again.
+    -- Due to the recursion here we will do this infinitely until we either cannot
+    -- run the junk effect, *or* we have a field that matches one of the choices of the permutation.
+    runWithEffect :: Permutation m whatever -> m whatever
+    runWithEffect (Permutation def failing choices) = (effAfter *> consumeRec) <|> maybe (eliminateFailing failing) pure def
+      where
+        consumeRec =
+          foldr ((<|>) . pars) empty choices
+            -- Run one of the effects from the permutation
+            <|> (takeSingle *> effAfter *> consumeRec)
+    -- Interleave a potentially infinite number of junk effects, with the separator effect between them.
+    pars :: Branch m whatever -> m whatever
+    pars (Branch perm arg) = do
+      a <- arg
+      rest <- runWithEffect perm
+      pure $ rest a
+
+asParser :: (Alternative f) => Permutation f a -> f a
+asParser (Permutation def failing choices) = asum (pars <$> choices) <|> maybe empty pure def <|> eliminateFailing failing
+  where
+    pars :: (Alternative f) => Branch f a -> f a
+    pars (Branch perm arg) = do
+      a <- arg
+      rest <- asParser perm
+      pure $ rest a
+
+asPermutation :: (Alternative f) => f a -> Permutation f a
+asPermutation p = Permutation Nothing NoFailingParser $ pure $ Branch (pure id) p
+
+asPermutationWithDefault :: (Alternative f) => f a -> a -> Permutation f a
+asPermutationWithDefault per def = Permutation (Just def) NoFailingParser $ pure $ Branch (pure id) per
+
+asPermutationWithFailing :: (Alternative f) => f a -> (forall b. f b) -> Permutation f a
+asPermutationWithFailing parse fail = Permutation Nothing (FailingParser fail) $ pure $ Branch (pure id) parse
+
+asPermutationWithDefaultFailing :: (Alternative f) => f a -> (forall b. f b) -> a -> Permutation f a
+asPermutationWithDefaultFailing parse fail def = Permutation (Just def) (FailingParser fail) $ pure $ Branch (pure id) parse
diff --git a/lib/Jordan/FromJSON/Internal/UnboxedParser.hs b/lib/Jordan/FromJSON/Internal/UnboxedParser.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/FromJSON/Internal/UnboxedParser.hs
@@ -0,0 +1,546 @@
+{-# LANGUAGE ApplicativeDo #-}
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE UnboxedSums #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedNewtypes #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+-- | A parser module using unboxed types for speed.
+--
+-- This is done because parsing to a JSON error report needs custom handling.
+module Jordan.FromJSON.Internal.UnboxedParser where
+
+import Control.Applicative
+import Control.Monad (when)
+import Data.Bifunctor
+import qualified Data.ByteString as BS
+import Data.ByteString.Internal
+import Data.Functor
+import Data.Monoid (Alt (..))
+import Data.Word
+import Debug.Trace (trace)
+import GHC.Exts
+import GHC.ForeignPtr
+import GHC.Prim
+import GHC.Types
+import GHC.Word
+import qualified Jordan.Types.Internal.AccumE as AE
+import Jordan.Types.JSONError (JSONArrayError, JSONError, JSONObjectError)
+import System.IO.Unsafe
+
+#if __GLASGOW_HASKELL__ > 900
+-- | Type of Word8 in GHC prim land. On GHC > 9.0, this is its own type.
+type WordPrim = Word8#
+#elif __GLASGOW_HASKELL__ > 800
+-- | Type of word8 in GHC prim land.
+-- On the GHC 8 series, this is 'Word#'.
+type WordPrim = Word#
+#endif
+
+-- | Newtype wrapper around the state of an input.
+--
+-- This is just the offset into the buffer.
+newtype InputState = InputState# {getInputOffset :: Int#}
+
+-- | Pattern synonym so we can use our above unlifted newtype like a record, if we do desire.
+pattern InputState :: Int# -> InputState
+pattern InputState {offset} =
+  InputState# offset
+
+{-# COMPLETE InputState #-}
+
+maxOffset :: InputState -> InputState -> InputState
+maxOffset (InputState# lhs) (InputState# rhs) =
+  InputState#
+    (if isTrue# (lhs ># rhs) then lhs else rhs)
+
+-- | Environment of a parser.
+--
+-- This is basically unpacked parts of a ByteString.
+newtype InputRead = InputRead# {getInputRead :: (# ForeignPtrContents, Addr#, Int# #)}
+
+pattern InputRead :: ForeignPtrContents -> Addr# -> Int# -> InputRead
+pattern InputRead {foreignPtr, addr, endOffset} = InputRead# (# foreignPtr, addr, endOffset #)
+
+{-# COMPLETE InputRead #-}
+
+-- | Unboxed type similar to 'Jordan.Types.Internal.AccumE'.
+newtype AccumE err a = AccumE {getAccumE :: (# err| a #)}
+
+pattern AccumER :: a -> AccumE err a
+pattern AccumER a = AccumE (# | a #)
+
+pattern AccumEL :: err -> AccumE err a
+pattern AccumEL err = AccumE (# err | #)
+
+{-# COMPLETE AccumEL, AccumER #-}
+
+newtype ParseResult# err res = ParseResult# {getParseResult# :: (# (# InputState, AccumE err res #)| (# #) #)}
+
+pattern JustParseResult :: InputState -> AccumE err res -> ParseResult# err res
+pattern JustParseResult {inputState, res} = ParseResult# (# (# inputState, res #) | #)
+
+pattern NoParseResult :: ParseResult# err res
+pattern NoParseResult = ParseResult# (# | (##) #)
+
+bimapAcc :: (err -> err') -> (a -> a') -> AccumE err a -> AccumE err' a'
+bimapAcc first _ (AccumEL a) = AccumEL (first a)
+bimapAcc _ second (AccumER a) = AccumER (second a)
+
+eitherAcc :: Either err a -> AccumE err a
+eitherAcc (Left e) = AccumEL e
+eitherAcc (Right a) = AccumER a
+
+appAcc ::
+  Semigroup err =>
+  AccumE err (a1 -> a2) ->
+  AccumE err a1 ->
+  AccumE err a2
+appAcc (AccumER f) (AccumER a) = AccumER (f a)
+appAcc (AccumEL lhs) (AccumEL rhs) = AccumEL (lhs <> rhs)
+appAcc (AccumEL lhs) _ = AccumEL lhs
+appAcc _ (AccumEL rhs) = AccumEL rhs
+
+accSet :: a1 -> AccumE err a2 -> AccumE err a1
+accSet a (AccumER _) = AccumER a
+accSet _ (AccumEL err) = AccumEL err
+
+{-# COMPLETE JustParseResult, NoParseResult #-}
+
+-- | We need a parser with *error recovery*.
+-- So the basic idea is that we separate errors reported during parsing from errors that make parsing stop.
+-- IE, if we expect a JSON null but we get a JSON string, and the string is well-formed, we can keep parsing, but we
+-- will *report* an error.
+newtype Parser# s err res = Parser# {runParser :: InputRead -> InputState -> State# s -> (# State# s, ParseResult# err res #)}
+
+bimapParser :: (err -> err') -> (a -> a') -> Parser# s err a -> Parser# s err' a'
+bimapParser l r (Parser# cb) = Parser# $ \env input s ->
+  case cb env input s of
+    (# s', a #) ->
+      (#
+        s',
+        case a of
+          NoParseResult -> NoParseResult
+          JustParseResult is e -> JustParseResult is (bimapAcc l r e)
+      #)
+
+fmapParser :: (a -> res) -> Parser# s err a -> Parser# s err res
+fmapParser f (Parser# cb) = Parser# $ \env input s ->
+  case cb env input s of
+    (# s', a #) ->
+      (#
+        s,
+        case a of
+          NoParseResult -> NoParseResult
+          JustParseResult is (AccumER !r) -> JustParseResult is (AccumER (f r))
+          JustParseResult is (AccumEL !l) -> JustParseResult is (AccumEL l)
+      #)
+{-# INLINE fmapParser #-}
+
+pureParser :: (Semigroup err) => a -> Parser# s err a
+pureParser !a = Parser# $ \_ state s -> (# s, JustParseResult state (AccumER a) #)
+{-# INLINE pureParser #-}
+
+apParser :: (Semigroup err) => Parser# s err (a -> b) -> Parser# s err a -> Parser# s err b
+apParser (Parser# fcb) (Parser# acb) = Parser# $ \env input s ->
+  case fcb env input s of
+    (# s', NoParseResult #) -> (# s', NoParseResult #)
+    (# s', JustParseResult !input' !f #) ->
+      case acb env input' s' of
+        (# s'', a #) ->
+          (#
+            s'',
+            case a of
+              NoParseResult -> NoParseResult
+              JustParseResult !input'' !a -> JustParseResult input'' (f `appAcc` a)
+          #)
+{-# SPECIALIZE apParser :: Parser# s JSONError (a -> b) -> Parser# s JSONError a -> Parser# s JSONError b #-}
+{-# SPECIALIZE apParser :: Parser# s JSONObjectError (a -> b) -> Parser# s JSONObjectError a -> Parser# s JSONObjectError b #-}
+{-# SPECIALIZE apParser :: Parser# s JSONArrayError (a -> b) -> Parser# s JSONArrayError a -> Parser# s JSONArrayError b #-}
+{-# INLINE apParser #-}
+
+-- | Alternative instance for a parser.
+-- This has weird behavior in that, if we have two results with delayed errors, this will act as if it skipped the *largest* amount
+-- of said errors.
+altParser :: (Monoid err) => Parser# s err a -> Parser# s err a -> Parser# s err a
+altParser (Parser# lhs) (Parser# rhs) = Parser# $ \env input s ->
+  let (# s', !lhs' #) = lhs env input s
+   in case lhs' of
+        -- If the parser failed to parse, we also fail to parse
+        NoParseResult -> rhs env input s'
+        JustParseResult state (AccumER !res) -> (# s', JustParseResult state (AccumER res) #)
+        JustParseResult state res@(AccumEL !err) ->
+          case rhs env input s' of
+            (# s'', NoParseResult #) -> (# s'', JustParseResult state res #)
+            (# s'', JustParseResult state' (AccumER !res) #) -> (# s'', JustParseResult (maxOffset state state') (AccumER res) #)
+            (# s'', JustParseResult state' (AccumEL !err') #) ->
+              (# s'', JustParseResult (maxOffset state state') (AccumEL (err <> err')) #)
+{-# SPECIALIZE altParser :: Parser# s JSONError a -> Parser# s JSONError a -> Parser# s JSONError a #-}
+{-# SPECIALIZE altParser :: Parser# s JSONObjectError a -> Parser# s JSONObjectError a -> Parser# s JSONObjectError a #-}
+{-# SPECIALIZE altParser :: Parser# s JSONArrayError a -> Parser# s JSONArrayError a -> Parser# s JSONArrayError a #-}
+{-# INLINE altParser #-}
+
+-- | Monadic bind for these parsers.
+--
+-- Note that this breaks the monad laws, as we do more error accumulation with (<*>) than we do ap.
+-- Oh well.
+bindParser :: Parser# s err a -> (a -> Parser# s err b) -> Parser# s err b
+bindParser (Parser# arg) cont =
+  Parser# $
+    {-# SCC unboxedParserBindInner #-}
+    \env state s ->
+      let (# s', result #) = arg env state s
+       in case result of
+            NoParseResult -> (# s', NoParseResult #)
+            JustParseResult state' (AccumEL err) -> (# s', JustParseResult state (AccumEL err) #)
+            JustParseResult state' (AccumER r) -> runParser (cont r) env state' s'
+{-# INLINE bindParser #-}
+
+emptyParser :: Parser# s err a
+emptyParser = Parser# $ \_ _ s -> (# s, NoParseResult #)
+
+newtype Parser err res = Parser {getParser :: Parser# RealWorld err res}
+  deriving (Semigroup, Monoid) via (Alt (Parser err) res)
+
+instance Bifunctor Parser where
+  bimap l r (Parser p) = Parser (bimapParser l r p)
+  {-# INLINE bimap #-}
+
+instance Functor (Parser err) where
+  fmap f (Parser a) = Parser (fmapParser f a)
+  {-# INLINE fmap #-}
+  a <$ (Parser (Parser# cb)) = Parser $
+    Parser# $ \env state token ->
+      let (# s', res #) = cb env state token
+       in case res of
+            NoParseResult -> (# s', NoParseResult #)
+            JustParseResult state r -> (# s', JustParseResult state (a `accSet` r) #)
+  {-# INLINE (<$) #-}
+
+instance (Semigroup err) => Applicative (Parser err) where
+  pure = Parser . pureParser
+  {-# INLINE pure #-}
+  (Parser f) <*> (Parser a) = Parser (f `apParser` a)
+  {-# INLINE (<*>) #-}
+  {-# SPECIALIZE (<*>) :: Parser JSONError (a -> b) -> Parser JSONError a -> Parser JSONError b #-}
+  {-# SPECIALIZE (<*>) :: Parser JSONObjectError (a -> b) -> Parser JSONObjectError a -> Parser JSONObjectError b #-}
+
+instance (Monoid err) => Alternative (Parser err) where
+  empty = Parser emptyParser
+  {-# INLINE empty #-}
+  (Parser l) <|> (Parser r) = Parser (l `altParser` r)
+  {-# INLINE (<|>) #-}
+
+instance (Semigroup err) => Monad (Parser err) where
+  (Parser f) >>= cb = Parser (f `bindParser` (\res -> getParser (cb res)))
+  {-# INLINE (>>=) #-}
+
+parseBSIO :: Parser err res -> ByteString -> IO (Maybe (AE.AccumE err res))
+parseBSIO (Parser (Parser# cb)) (PS (ForeignPtr addr contents) offset' len) = IO parse'
+  where
+    (I# endOffset) = offset' + len
+    (I# startOffset) = offset'
+    parse' s =
+      let (# s', res #) = cb (InputRead contents addr endOffset) (InputState# startOffset) s
+       in case res of
+            NoParseResult -> (# s', Nothing #)
+            JustParseResult _ (AccumEL err) -> (# s', Just (AE.AccumEL err) #)
+            JustParseResult _ (AccumER res) -> (# s', Just (AE.AccumER res) #)
+
+parseBS :: Parser err res -> ByteString -> Maybe (AE.AccumE err res)
+parseBS parser bs = unsafeDupablePerformIO (parseBSIO parser bs)
+
+currentOffset :: Parser err Int
+currentOffset = Parser $
+  Parser# $ \env i@(InputState# cs) s ->
+    (# s, JustParseResult i (AccumER (I# cs)) #)
+{-# INLINE currentOffset #-}
+
+getEndOffset :: Parser err Int
+getEndOffset = Parser $
+  Parser# $ \env i s ->
+    (# s, JustParseResult i (AccumER (I# (endOffset env))) #)
+{-# INLINE getEndOffset #-}
+
+parsedPtr :: Parser err (ForeignPtr Word8)
+parsedPtr = Parser $
+  Parser# $ \env i s -> (# s, JustParseResult i (AccumER $ ForeignPtr (addr env) (foreignPtr env)) #)
+
+currentEnv :: Parser err (ForeignPtrContents, Ptr a, Int)
+currentEnv = Parser $
+  Parser# $ \env i s -> (# s, JustParseResult i (AccumER (foreignPtr env, Ptr (addr env), I# (endOffset env))) #)
+
+failParse :: Parser err a
+failParse = Parser $
+  Parser# $ \env i s -> (# s, NoParseResult #)
+
+maybeWord :: Parser err (Maybe Word8)
+maybeWord = Parser $
+  Parser# $ \env state@(InputState# input) s ->
+    if isTrue# (input ==# endOffset env)
+      then (# s, JustParseResult state (AccumER Nothing) #)
+      else
+        let (# s', word #) = readWord8OffAddr# (addr env) input s
+         in (# s', JustParseResult (InputState# (input +# 1#)) (AccumER $ Just $ W8# word) #)
+
+orFail :: Parser err (Maybe a) -> Parser err a
+orFail (Parser (Parser# cb)) = Parser $
+  Parser# $ \env s state ->
+    let (# s', r #) = cb env s state
+     in case r of
+          NoParseResult -> (# s', NoParseResult #)
+          JustParseResult state a ->
+            case a of
+              AccumER (Just a) -> (# s', JustParseResult state (AccumER a) #)
+              _ -> (# s', NoParseResult #)
+
+failWith :: err -> Parser err a
+failWith err = Parser $
+  Parser# $ \env s state -> (# state, JustParseResult s (AccumEL err) #)
+
+asFailure :: Parser err err -> Parser err a
+asFailure (Parser (Parser# cb)) = Parser $
+  Parser# $ \env s state ->
+    let (# s', r #) = cb env s state
+     in case r of
+          NoParseResult -> (# s', NoParseResult #)
+          JustParseResult state a ->
+            case a of
+              AccumER a -> (# s', JustParseResult state (AccumEL a) #)
+              AccumEL a -> (# s', JustParseResult state (AccumEL a) #)
+
+-- | Lower a parsed error to a *parser error*.
+lowerErr :: Parser err (Either err a) -> Parser err a
+lowerErr (Parser (Parser# cb)) = Parser $
+  Parser# $ \env s state ->
+    let (# s', r #) = cb env s state
+     in case r of
+          NoParseResult -> (# s', NoParseResult #)
+          JustParseResult state res ->
+            case res of
+              AccumER e -> (# s', JustParseResult state (eitherAcc e) #)
+              AccumEL l -> (# s', JustParseResult state (AccumEL l) #)
+
+-- | Do we have any further input?
+hasFurther :: Parser err Bool
+hasFurther = Parser $
+  Parser# $ \env i@(InputState# input) s ->
+    if isTrue# (input ==# endOffset env)
+      then (# s, JustParseResult i (AccumER False) #)
+      else (# s, JustParseResult i (AccumER True) #)
+
+-- | Advance forward one word, fail if we can't
+advanceWord :: Parser err ()
+advanceWord = Parser $
+  Parser# $ \env (InputState# input) s ->
+    if isTrue# (input ==# endOffset env)
+      then (# s, NoParseResult #)
+      else (# s, JustParseResult (InputState# (input +# 1#)) (AccumER ()) #)
+
+-- | Peek the next word, fail if there's nothing there
+peekWord :: Parser err Word8
+peekWord = Parser $
+  Parser# $ \env i@(InputState# input) s ->
+    if isTrue# (input ==# endOffset env)
+      then (# s, NoParseResult #)
+      else
+        let (# s', word #) = readWord8OffAddr# (addr env) input s
+         in (# s', JustParseResult i (AccumER $ W8# word) #)
+
+-- | Peek a word, or nothing.
+-- Never fails.
+peekWordMaybe :: Parser err (Maybe Word8)
+peekWordMaybe = Parser $
+  Parser# $ \env i@(InputState# input) s ->
+    if isTrue# (input ==# endOffset env)
+      then (# s, JustParseResult i (AccumER Nothing) #)
+      else
+        let (# s', word #) = readWord8OffAddr# (addr env) input s
+         in (# s', JustParseResult i (AccumER (Just (W8# word))) #)
+
+word :: Parser err Word8
+word = Parser $
+  Parser# $ \env (InputState# input) s ->
+    if isTrue# (input ==# endOffset env)
+      then (# s, NoParseResult #)
+      else
+        let (# s', word #) = readWord8OffAddr# (addr env) input s
+         in (# s', JustParseResult (InputState# (input +# 1#)) (AccumER $ W8# word) #)
+
+specificWord w = orFail (cb <$> word)
+  where
+    cb w' =
+      if w == w' then Just () else Nothing
+
+-- | Skip over while the callback returns true.
+--
+-- Unlifted version, probably use skipWord8
+skipWord8# :: (WordPrim -> Bool) -> Parser err ()
+skipWord8# cb =
+  Parser $
+    Parser# (skipWord8CB# cb)
+{-# INLINE skipWord8# #-}
+
+-- | Skip over while the callback returns true
+skipWord8 :: (Word8 -> Bool) -> Parser err ()
+skipWord8 cb = skipWord8# (\byte -> cb (W8# byte {- HLINT ignore "Avoid lambda" -}))
+{-# INLINE skipWord8 #-}
+
+-- | Private: callback used for skipWord8
+skipWord8CB# ::
+  (WordPrim -> Bool) ->
+  InputRead ->
+  InputState ->
+  State# RealWorld ->
+  (# State# RealWorld, ParseResult# err () #)
+skipWord8CB# cb env (InputState# input) s =
+  let (# s', newOff #) = go input s
+   in (# s', JustParseResult (InputState# newOff) (AccumER ()) #)
+  where
+    go :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
+    go inputOffset s =
+      if isTrue# (inputOffset ==# endOffset env)
+        then (# s, inputOffset #)
+        else
+          let (# s', word #) = readWord8OffAddr# (addr env) inputOffset s
+           in if cb word then go (inputOffset +# 1#) s' else (# s', inputOffset #)
+
+skipWhitespace :: Parser err ()
+skipWhitespace = Parser $ Parser# skipWhitespaceCB
+{-# INLINE skipWhitespace #-}
+
+skipWhitespaceCB ::
+  InputRead ->
+  InputState ->
+  State# RealWorld ->
+  (# State# RealWorld, ParseResult# err () #)
+skipWhitespaceCB env (InputState# input) s =
+  let (# s', newOff #) = go input s
+   in (# s', JustParseResult (InputState# newOff) (AccumER ()) #)
+  where
+    go :: Int# -> State# RealWorld -> (# State# RealWorld, Int# #)
+    go inputOffset s
+      | isTrue# (inputOffset ==# endOffset env) = (# s, inputOffset #)
+      | otherwise =
+        let (# s', word #) = readWord8OffAddr# (addr env) inputOffset s
+         in case W8# word of
+              40 -> go (inputOffset +# 1#) s'
+              0x20 -> go (inputOffset +# 1#) s'
+              0x0A -> go (inputOffset +# 1#) s'
+              0x0D -> go (inputOffset +# 1#) s'
+              0x09 -> go (inputOffset +# 1#) s'
+              _ -> (# s', inputOffset #)
+    {-# INLINE go #-}
+{-# INLINE skipWhitespaceCB #-}
+
+signed :: (Monoid err, Num a) => Parser err a -> Parser err a
+signed parser = withSign <|> parser
+  where
+    withSign = do
+      r <- (specificWord 43 $> True) <|> (specificWord 45 $> False)
+      if r
+        then negate <$> parser
+        else parser
+{-# INLINE signed #-}
+
+orNegative :: (Monoid err, Num a) => Parser err a -> Parser err a
+orNegative parse =
+  (specificWord 45 *> (negate <$> parse))
+    <|> parse
+{-# INLINE orNegative #-}
+
+-- | Parse an integral number with possible leading zeros.
+parseIntegral :: forall err i. (Monoid err, Integral i) => Parser err (Int, i)
+parseIntegral = parseIntegralGo 0 0
+{-# INLINE parseIntegral #-}
+
+parseIntegralNoLeadingZero :: forall err i. (Monoid err, Integral i) => Parser err (Int, i)
+parseIntegralNoLeadingZero = do
+  w <- word
+  if w >= 49 && w <= 57
+    then parseIntegralGo 1 (fromIntegral $ w - 48)
+    else failParse
+{-# INLINE parseIntegralNoLeadingZero #-}
+
+parseIntegralGo :: (Monoid err, Integral i) => Int -> i -> Parser err (Int, i)
+parseIntegralGo digits acc = do
+  r <- peekWordMaybe
+  case r of
+    Nothing -> pure (digits, acc)
+    Just !w
+      | w >= 48 && w <= 57 -> do
+        let !accd = fromIntegral $ w - 48
+        let !after = (acc * 10) + accd
+        if after < 0 -- checks for overflow.
+          then failParse
+          else word *> parseIntegralGo (digits + 1) after
+      | otherwise -> failParse
+{-# SPECIALIZE parseIntegralGo :: (Monoid err) => Int -> Int -> Parser err (Int, Int) #-}
+{-# SPECIALIZE parseIntegralGo :: (Monoid err) => Int -> Integer -> Parser err (Int, Integer) #-}
+
+takeWord8Cont :: (Semigroup err) => (Word8 -> Bool) -> (BS.ByteString -> a) -> Parser err a
+takeWord8Cont cb cont = do
+  ptr <- parsedPtr
+  offsetBefore <- currentOffset
+  skipWord8 cb
+  offsetAfter <- currentOffset
+  pure $ cont (PS ptr offsetBefore (offsetAfter - offsetBefore))
+{-# INLINE takeWord8Cont #-}
+
+takeWord8 :: (Semigroup err) => (Word8 -> Bool) -> Parser err BS.ByteString
+takeWord8 cb = takeWord8Cont cb id
+
+takeWord81 :: (Semigroup err) => (Word8 -> Bool) -> Parser err BS.ByteString
+takeWord81 cb = takeWord81Cont cb id
+
+takeWord81Cont ::
+  Semigroup err =>
+  (Word8 -> Bool) ->
+  (ByteString -> b) ->
+  Parser err b
+takeWord81Cont cb cont = do
+  ptr <- parsedPtr
+  offsetBefore <- currentOffset
+  skipWord8 cb
+  offsetAfter <- currentOffset
+  let len = offsetAfter - offsetBefore
+  when (len < 1) failParse
+  pure $ cont (PS ptr offsetBefore len)
+
+peekRest :: (Semigroup err) => Parser err BS.ByteString
+peekRest = do
+  ptr <- parsedPtr
+  offset <- currentOffset
+  es <- getEndOffset
+  pure $ PS ptr offset (es - offset)
+
+chunkOfLength :: Int -> Parser err BS.ByteString
+chunkOfLength len@(I# len') = Parser $
+  Parser# $ \env is@(InputState# off) s ->
+    if
+        | len < 0 -> (# s, NoParseResult #)
+        | isTrue# (off +# len' ># endOffset env) -> (# s, NoParseResult #)
+        | otherwise ->
+          (#
+            s,
+            JustParseResult
+              (InputState# (off +# len'))
+              (AccumER $ PS (ForeignPtr (addr env) (foreignPtr env)) (I# off) len)
+          #)
+
+parseChunk :: ByteString -> Parser err ()
+parseChunk chunk = orFail $ isChunkMaybe <$> chunkOfLength (BS.length chunk)
+  where
+    isChunkMaybe c = if chunk == c then Just () else Nothing
+
+testParser :: Parser () (Word8, ByteString)
+testParser = ((,) <$> word <*> takeWord8 (\c -> c >= 38 && c <= 57)) <|> ((,) <$> word <*> pure mempty)
diff --git a/lib/Jordan/FromJSON/Internal/UnboxedReporting.hs b/lib/Jordan/FromJSON/Internal/UnboxedReporting.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/FromJSON/Internal/UnboxedReporting.hs
@@ -0,0 +1,351 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+module Jordan.FromJSON.Internal.UnboxedReporting where
+
+import Control.Applicative (Alternative (empty, (<|>)))
+import Control.Applicative.Combinators (sepBy)
+import Control.Monad (when)
+import Data.Bifunctor
+import qualified Data.ByteString as BS
+import Data.ByteString.Unsafe as BS
+import Data.Char (chr, isControl, ord)
+import Data.Functor (void, ($>))
+import qualified Data.Map.Strict as Map
+import Data.Maybe (isJust)
+import Data.Monoid (Alt (..))
+import Data.Scientific (Scientific)
+import qualified Data.Scientific as Scientific
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
+import Data.Word (Word8)
+import Debug.Trace (traceM)
+import Jordan.FromJSON.Class
+import Jordan.FromJSON.Internal.Attoparsec (bsToInteger)
+import Jordan.FromJSON.Internal.Permutation
+import Jordan.FromJSON.Internal.UnboxedParser as UP hiding (AccumE (..), AccumEL, AccumER)
+import Jordan.Types.Internal.AccumE (AccumE (AccumE))
+import Jordan.Types.JSONError
+  ( JSONArrayError (..),
+    JSONError
+      ( ErrorBadArray,
+        ErrorBadObject,
+        ErrorBadTextConstant,
+        ErrorBadType,
+        ErrorInvalidJSON,
+        ErrorMesage,
+        ErrorNoValue
+      ),
+    JSONObjectError (..),
+  )
+import Jordan.Types.JSONType (JSONType (..))
+import Numeric (showHex)
+
+skipWithFailure :: JSONError -> Parser JSONError a
+skipWithFailure err =
+  UP.asFailure $
+    skipAnything $> err
+
+lexeme :: Semigroup err => Parser err a -> Parser err a
+lexeme p = p <* UP.skipWhitespace
+{-# INLINE lexeme #-}
+
+jsonTypeFromWord :: Word8 -> Maybe JSONType
+jsonTypeFromWord jt
+  | jt == 34 = pure JSONTypeText
+  | jt == 116 || jt == 102 = pure JSONTypeBool
+  | jt == 110 = pure JSONTypeNull
+  | jt >= 48 && jt <= 57 = pure JSONTypeNumber
+  | jt == 45 = pure JSONTypeNumber
+  | jt == 91 = pure JSONTypeArray
+  | jt == 123 = pure JSONTypeObject
+  | otherwise = Nothing
+{-# INLINE jsonTypeFromWord #-}
+
+peekJSONType :: (Monoid err) => Parser err JSONType
+peekJSONType = UP.orFail (jsonTypeFromWord <$> UP.peekWord)
+{-# INLINE peekJSONType #-}
+
+skipNullExpecting :: JSONType -> Parser JSONError a
+skipNullExpecting jt =
+  UP.asFailure $ nullParser $> ErrorBadType jt JSONTypeNull
+
+-- | Parse a NULL value.
+nullParser :: Semigroup err => Parser err ()
+nullParser = lexeme $ UP.parseChunk "null" $> ()
+{-# INLINE nullParser #-}
+
+skipBoolExpecting :: JSONType -> Parser JSONError a
+skipBoolExpecting jt =
+  UP.asFailure $
+    boolParser $> ErrorBadType jt JSONTypeBool
+{-# INLINE skipBoolExpecting #-}
+
+boolParser :: (Monoid err) => Parser err Bool
+boolParser =
+  lexeme $
+    (UP.parseChunk "true" $> True)
+      <|> (UP.parseChunk "false" $> False)
+{-# INLINE boolParser #-}
+
+skipTextExpecting :: JSONType -> Parser JSONError a
+skipTextExpecting jt =
+  UP.asFailure $
+    textParser $> ErrorBadType jt JSONTypeText
+{-# INLINE skipTextExpecting #-}
+
+textParser :: (Monoid err) => Parser err T.Text
+textParser = lexeme $ do
+  UP.specificWord 34
+  parseAfterQuote
+{-# INLINE textParser #-}
+
+sepByVoid :: Alternative f => f a1 -> f a2 -> f ()
+sepByVoid elem sep = void $ sepBy (void elem) sep
+{-# INLINE sepByVoid #-}
+
+skipNumber :: (Monoid err) => Parser err ()
+skipNumber = void scientific
+{-# INLINE skipNumber #-}
+
+skipNumberExpecting :: JSONType -> Parser JSONError a
+skipNumberExpecting jt =
+  UP.asFailure $
+    skipNumber $> ErrorBadType jt JSONTypeNumber
+
+skipAnything :: Monoid err => Parser err ()
+skipAnything = do
+  r <- UP.peekWord
+  if
+      | r == 110 -> lexeme $ UP.parseChunk "null"
+      | r == 116 -> lexeme $ UP.parseChunk "true" -- t -> true
+      | r == 102 -> lexeme $ UP.parseChunk "false"
+      | r == 34 -> void textParser -- " -> text
+      | r == 123 -> skipObject -- { -> object
+      | r == 91 -> skipArray -- [ -> array
+      | r == 45 || (r >= 48 && r <= 57) -> skipNumber
+      | otherwise -> (orFail $ pure Nothing)
+{-# INLINE skipAnything #-}
+
+skipArray :: (Monoid err) => Parser err ()
+skipArray = do
+  startArray
+  sepByVoid skipAnything comma
+  endArray
+{-# INLINE skipArray #-}
+
+kvSep :: Semigroup err => Parser err ()
+kvSep = lexeme $ UP.specificWord 58
+
+skipAnyKV :: Monoid err => Parser err ()
+skipAnyKV = do
+  textParser
+  kvSep
+  skipAnything
+
+comma :: Semigroup err => Parser err ()
+comma = lexeme $ UP.specificWord 44
+
+skipObject :: Monoid err => Parser err ()
+skipObject = do
+  lexeme $ UP.specificWord 123
+  sepByVoid skipAnyKV comma
+  lexeme $ UP.specificWord 125
+{-# INLINE skipObject #-}
+
+failOnError :: (Monoid err) => Either a T.Text -> Parser err T.Text
+failOnError = \case
+  Left _ -> failParse
+  Right txt -> pure txt
+
+parseAfterQuote :: (Monoid err) => Parser err T.Text
+parseAfterQuote = do
+  chunk <- UP.takeWord8Cont (\c -> c /= 92 && c /= 34) decodeUtf8'
+  decoded <- failOnError chunk
+  (lexeme (specificWord 34) $> decoded) <|> do
+    specificWord 92
+    escape <- parseEscape
+    res <- parseAfterQuote
+    pure $ decoded <> escape <> res
+{-# INLINE parseAfterQuote #-}
+
+hexDigit :: Semigroup err => Parser err Word8
+hexDigit = do
+  r <- UP.word
+  orFail $
+    if
+        | r >= 48 && r <= 57 -> pure $ Just (r - 48)
+        | r >= 97 && r <= 103 -> pure $ Just ((r - 97) + 10)
+        | otherwise -> pure Nothing
+{-# INLINE hexDigit #-}
+
+parseEscape :: (Monoid err) => UP.Parser err T.Text
+parseEscape =
+  quote
+    <|> backslash
+    <|> solidus
+    <|> backspace
+    <|> formfeed
+    <|> linefeed
+    <|> carriage
+    <|> tab
+    <|> unicode
+  where
+    quote = specificWord 34 $> "\""
+    backslash = specificWord 92 $> "\\"
+    solidus = specificWord 47 $> "/"
+    backspace = specificWord 98 $> "\b"
+    formfeed = specificWord 102 $> "\f"
+    linefeed = specificWord 110 $> "\n"
+    carriage = specificWord 114 $> "\r"
+    tab = specificWord 116 $> "\t"
+    unicode = do
+      specificWord 117
+      a <- hexDigit
+      b <- hexDigit
+      c <- hexDigit
+      d <- hexDigit
+      let res = (((fromIntegral a * 16) + fromIntegral b) * 16 + fromIntegral c) * 16 + fromIntegral d
+      pure $ T.pack [chr res]
+{-# INLINE parseEscape #-}
+
+parseCharInText (c :: Char) = parseLit c <|> escaped c
+  where
+    parseLit = \case
+      '\\' -> UP.parseChunk "\\\\"
+      '"' -> UP.parseChunk "\\\""
+      '/' -> UP.parseChunk "/" <|> UP.parseChunk "\\/"
+      '\b' -> UP.parseChunk "\\b"
+      '\f' -> UP.parseChunk "\\f"
+      '\n' -> UP.parseChunk "\\n"
+      '\r' -> UP.parseChunk "\\r"
+      '\t' -> UP.parseChunk "\\t"
+      a -> if isControl a then empty else UP.parseChunk (encodeUtf8 $ T.singleton a)
+    escaped c = UP.parseChunk $ encodeUtf8 $ "\\u" <> T.justifyRight 4 '0' (T.pack $ showHex (ord c) mempty)
+{-# INLINE parseCharInText #-}
+
+parseSpecificKeyInQuotes :: Monoid err => T.Text -> Parser err ()
+parseSpecificKeyInQuotes t = UP.specificWord 34 *> parseSpecificKeyAfterQuote t
+{-# INLINE parseSpecificKeyInQuotes #-}
+
+parseSpecificKeyAfterQuote :: Monoid err => T.Text -> Parser err ()
+parseSpecificKeyAfterQuote key = (parseRaw <|> parseChars) *> lexeme (UP.specificWord 34)
+  where
+    parseChars = T.foldr (\c a -> parseCharInText c *> a) (pure ()) key
+    parseRaw =
+      if isJust $ T.findIndex invalidTextChar key
+        then empty
+        else UP.parseChunk (encodeUtf8 key)
+
+startBracket :: Semigroup err => Parser err ()
+startBracket = lexeme $ UP.specificWord 123
+
+endBracket :: Semigroup err => Parser err ()
+endBracket = lexeme $ UP.specificWord 125
+
+startArray :: Semigroup err => Parser err ()
+startArray = lexeme $ UP.specificWord 91
+
+endArray :: Semigroup err => Parser err ()
+endArray = lexeme $ UP.specificWord 93
+
+parseObjectKV :: Monoid err => T.Text -> Parser err b -> Parser err b
+parseObjectKV key v = do
+  lexeme $ parseSpecificKeyInQuotes key
+  lexeme $ UP.specificWord 58
+  v
+
+invalidTextChar :: Char -> Bool
+invalidTextChar c =
+  c == '"'
+    || c == '\\'
+    || isControl c
+
+data SP = SP !Integer {-# UNPACK #-} !Int
+
+-- A sub-quadratic algorithm for Integer. Pairs of adjacent radix b
+-- digits are combined into a single radix b^2 digit. This process is
+-- repeated until we are left with a single digit. This algorithm
+-- performs well only on large inputs, so we use the simple algorithm
+-- for smaller inputs.
+valInteger :: Integer -> Int -> [Integer] -> Integer
+valInteger = go
+  where
+    go :: Integer -> Int -> [Integer] -> Integer
+    go _ _ [] = 0
+    go _ _ [d] = d
+    go b l ds
+      | l > 40 = b' `seq` go b' l' (combine b ds')
+      | otherwise = valSimple b ds
+      where
+        -- ensure that we have an even number of digits
+        -- before we call combine:
+        ds' = if even l then ds else 0 : ds
+        b' = b * b
+        l' = (l + 1) `quot` 2
+
+    combine b (d1 : d2 : ds) = d `seq` (d : combine b ds)
+      where
+        d = d1 * b + d2
+    combine _ [] = []
+    combine _ [_] = errorWithoutStackTrace "this should not happen"
+{-# INLINE valInteger #-}
+
+-- The following algorithm is only linear for types whose Num operations
+-- are in constant time.
+valSimple :: Integer -> [Integer] -> Integer
+valSimple base = go 0
+  where
+    go r [] = r
+    go r (d : ds) = r' `seq` go r' ds
+      where
+        r' = r * base + fromIntegral d
+{-# INLINE valSimple #-}
+
+isDigitWord8 :: Word8 -> Bool
+isDigitWord8 c = c >= 48 && c <= 57
+{-# INLINE isDigitWord8 #-}
+
+decimal0 :: Semigroup err => Parser err Integer
+decimal0 = do
+  let zero = 48
+  digits <- UP.takeWord8 isDigitWord8
+  let !length = BS.length digits
+  when (length == 0) UP.failParse
+  if length > 1 && BS.unsafeHead digits == zero
+    then UP.failParse
+    else return (bsToInteger digits)
+{-# INLINE decimal0 #-}
+
+scientific :: (Monoid err) => UP.Parser err Scientific
+scientific = lexeme $ do
+  let minus = 45
+      plus = 43
+  sign <- UP.peekWord
+  let !positive = sign == plus || sign /= minus
+  when (sign == plus || sign == minus) $
+    void UP.word
+  n <- decimal0
+  let f fracDigits =
+        SP
+          (BS.foldl' step n fracDigits)
+          (negate $ BS.length fracDigits)
+      step a w = a * 10 + fromIntegral (w - 48)
+  dotty <- UP.peekWordMaybe
+  SP c e <- case dotty of
+    Just 46 -> UP.word *> UP.takeWord81Cont isDigitWord8 f
+    _ -> pure (SP n 0)
+  let !signedCoeff
+        | positive = c
+        | otherwise = - c
+  ( (UP.specificWord 101 <|> UP.specificWord 69)
+      *> fmap (Scientific.scientific signedCoeff . (e +)) (UP.signed (snd <$> UP.parseIntegral))
+    )
+    <|> pure (Scientific.scientific signedCoeff e)
+{-# INLINE scientific #-}
diff --git a/lib/Jordan/FromJSON/Megaparsec.hs b/lib/Jordan/FromJSON/Megaparsec.hs
deleted file mode 100644
--- a/lib/Jordan/FromJSON/Megaparsec.hs
+++ /dev/null
@@ -1,295 +0,0 @@
-{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE DerivingStrategies #-}
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeSynonymInstances #-}
-module Jordan.FromJSON.Megaparsec
-    where
-
-import Control.Applicative
-import Control.Applicative.Combinators (sepBy)
-import qualified Data.ByteString as ByteString
-import Data.Char (chr, digitToInt, isControl, isHexDigit, ord)
-import Data.Foldable (asum, traverse_)
-import Data.Functor (void, ($>))
-import Data.List (intercalate)
-import Data.Monoid (Alt(..))
-import Data.Scientific (Scientific(..))
-import qualified Data.Text as Text
-import qualified Data.Text.Encoding as Encoding
-import Data.Void (Void)
-import Data.Word (Word8)
-import Debug.Trace (trace, traceM)
-import Jordan.FromJSON.Class
-import Jordan.FromJSON.ParseInternal
-import Numeric (showHex)
-import Text.Megaparsec ((<?>))
-import qualified Text.Megaparsec as T
-import qualified Text.Megaparsec.Char as Char
-import qualified Text.Megaparsec.Char.Lexer as Lexer
-
-type Parser = T.Parsec ErrorContext Text.Text
-type ParseError = T.ParseErrorBundle Text.Text ErrorContext
-
-newtype ErrorContext
-  = ErrorContext { getErrorContext :: [Text.Text] }
-  deriving (Show, Eq, Ord)
-
-instance T.ShowErrorComponent ErrorContext where
-  showErrorComponent
-    = intercalate ", "
-    . fmap (("in " ++) . Text.unpack)
-    . getErrorContext
-
-newtype ObjectParser a = ObjectParser { getObjectParser :: Permutation Parser a }
-  deriving newtype (Functor, Applicative)
-
-newtype ArrayParser a
-  = ArrayParser { getArrayParser :: Parser a }
-  deriving (Functor)
-
-instance Applicative ArrayParser where
-  pure = ArrayParser . pure
-  (ArrayParser f) <*> (ArrayParser a) = ArrayParser $
-    (f <* comma) <*> a
-
-lexeme :: Parser a -> Parser a
-lexeme = Lexer.lexeme $ Lexer.space Char.space1 empty empty
-
-takeSpace :: Parser ()
-takeSpace = void $ many Char.space1
-
-parseAnyField :: Parser ()
-parseAnyField = T.label "an extraneous object field we do not care about" $ do
-  T.label "ignored object key" parseJSONText
-  lexeme $ Char.char ':'
-  lexeme consumeJunkValue
-
-objectKey :: Text.Text -> Parser ()
-objectKey k = T.label ("object key '" <> Text.unpack k <> "'") $ lexeme $ do
-  Char.char '"'
-  T.label "object label" $
-    Text.foldr (\c a -> parseCharInText c *> a) (pure ()) k
-  Char.char '"'
-  pure ()
-
-parseCharInText :: Char -> Parser ()
-parseCharInText a = parseLit a <|> escaped a
-  where
-    parseLit :: Char -> Parser ()
-    parseLit = \case
-      '\\' -> void $ T.chunk "\\\\"
-      '"' -> void $ T.chunk "\\\""
-      '/' -> void $ T.chunk "/" <|> T.chunk "\\/"
-      '\b' -> void $ T.chunk "\\b"
-      '\f' -> void $ T.chunk "\\f"
-      '\n' -> void $ T.chunk "\\n"
-      '\r' -> void $ T.chunk "\\r"
-      '\t' -> void $ T.chunk "\\t"
-      a -> if isControl a then empty else void $ T.single a
-    escaped :: Char -> Parser ()
-    escaped a = void $ T.chunk $ Text.pack $ withEscaped $ (showHex $ ord a) []
-    withEscaped :: String -> String
-    withEscaped a@[_] = "\\u000" <> a
-    withEscaped a@[_,_] = "\\u00" <> a
-    withEscaped a@[_,_,_] = "\\u0" <> a
-    withEscaped r = "\\u" <> r
-
-parseDictField
-  :: Parser a
-  -> Parser (Text.Text, a)
-parseDictField valParser = do
-  key <- parseJSONText
-  labelSep
-  val <- valParser
-  pure (key, val)
-
-parseObjectField
-  :: Text.Text
-  -> Parser a
-  -> Parser a
-parseObjectField t f = do
-  T.try $ objectKey t
-  labelSep
-  lexeme f
-
-parseJSONText :: Parser Text.Text
-parseJSONText = lexeme $ do
-  T.try $ Char.char '"'
-  innerText
-
-innerText :: Parser Text.Text
-innerText = do
-  chunk <- T.takeWhileP Nothing $ \char -> char /= '\\' && char /= '"'
-  l <- T.lookAhead $ T.option Nothing (Just <$> T.anySingle)
-  case l of
-    Nothing -> fail "string without end"
-    Just '"' -> do
-      T.label "quotation mark" T.anySingle
-      pure chunk
-    Just '\\' -> do
-      T.anySingle
-      r <- parseEscape
-      rest <- innerText
-      pure $ chunk <> r <> rest
-    Just _ -> fail "IMPOSSIBLE"
-
-parseEscape :: Parser Text.Text
-parseEscape
-  = quote
-  <|> backslash
-  <|> solidus
-  <|> backspace
-  <|> formfeed
-  <|> linefeed
-  <|> carriage
-  <|> tab
-  <|> escapedUnicode
-  where
-    backslash = T.chunk "\\"
-    quote = T.chunk "\""
-    solidus = T.chunk "/" $> "/"
-    backspace = T.chunk "b" $> "\b"
-    formfeed = T.chunk "f" $> "\f"
-    linefeed = T.chunk "n" $> "\n"
-    carriage = T.chunk "r" $> "\r"
-    tab = T.chunk "t" $> "\t"
-    escapedUnicode = T.label "unicode escape code" $ do
-      Char.char 'u'
-      a <- parseHexDigit
-      b <- parseHexDigit
-      c <- parseHexDigit
-      d <- parseHexDigit
-      let s = (((a * 16) + b) * 16 + c) * 16 + d
-      pure $ Text.pack [chr s]
-
-parseHexDigit :: Parser Int
-parseHexDigit = digitToInt <$> T.satisfy isHexDigit
-
-comma :: Parser ()
-comma = void $ lexeme $ Char.char ','
-
-labelSep :: Parser ()
-labelSep = void $ lexeme $ Char.char ':'
-
-parseAnyObject :: Parser ()
-parseAnyObject = T.label "Ignored object" $ do
-  T.try $ lexeme $ Char.char '{'
-  parseAnyField `sepBy` comma
-  lexeme $ Char.char '}'
-  pure ()
-
-parseAnyArray :: Parser ()
-parseAnyArray = T.label "Ignored array" $ do
-  T.try $ lexeme $ Char.char '['
-  consumeJunkValue `sepBy` comma
-  lexeme $ Char.char ']'
-  pure ()
-
-consumeJunkValue :: Parser ()
-consumeJunkValue
-  = void parseAnyObject
-  <|> void parseAnyArray
-  <|> void parseJSONText
-  <|> void parseJSONNumber
-  <|> void parseJSONNull
-
-parseJSONNumber :: Parser Scientific
-parseJSONNumber = Lexer.signed (pure ()) Lexer.scientific
-
-parseJSONNull :: Parser ()
-parseJSONNull = void $ lexeme $ T.chunk "null"
-
-parseJSONBool :: Parser Bool
-parseJSONBool = lexeme $ (T.chunk "true" $> True) <|> (T.chunk "false" $> False)
-
-junkFieldsAtEnd :: Parser ()
-junkFieldsAtEnd = T.label "misc fields after parsing is done" $ do
-  comma
-  parseAnyField `sepBy` comma
-  pure ()
-
-newtype MegaparsecParser a
-  = MegaparsecParser { getMegaparsecParser :: Parser a }
-  deriving (Functor)
-  deriving (Monoid) via (Alt Parser a)
-
-instance Semigroup (MegaparsecParser a) where
-  (MegaparsecParser a) <> (MegaparsecParser b) = MegaparsecParser $ T.try a <|> T.try b
-
-instance JSONObjectParser ObjectParser where
-  parseFieldWith label
-    = ObjectParser
-    . asPermutation
-    . T.label ("field " <> Text.unpack label)
-    . parseObjectField label
-    . getMegaparsecParser
-
-instance JSONTupleParser ArrayParser where
-  consumeItemWith = ArrayParser . getMegaparsecParser
-
-instance JSONParser MegaparsecParser where
-  parseObject name p = MegaparsecParser $ T.label (Text.unpack name <> " object") $ do
-    T.label "object start" $ lexeme $ Char.char '{'
-    r <- wrapEffect parseAnyField comma $ getObjectParser p
-    T.label "object end" $ T.optional junkFieldsAtEnd
-    lexeme $ Char.char '}'
-    pure r
-  parseDictionary valParser = MegaparsecParser $ T.label "dictionary" $ do
-    lexeme $ Char.char '{'
-    r <- parseDictField (getMegaparsecParser valParser) `sepBy` comma
-    lexeme $ Char.char '}'
-    pure r
-  parseTuple p = MegaparsecParser $ do
-    lexeme $ T.label "Array start" $ Char.char '['
-    r <- getArrayParser p
-    lexeme $ T.label "Array end" $ Char.char ']'
-    pure r
-  parseArrayWith p = MegaparsecParser $ do
-    lexeme $ T.label "Array start" $ Char.char '['
-    r <- getMegaparsecParser p `sepBy` comma
-    lexeme $ T.label "Array end" $ Char.char ']'
-    pure r
-  parseTextConstant t = MegaparsecParser $ T.label "text constant" $ do
-    Char.char '"'
-    Text.foldr (\c a -> parseCharInText c *> a) (pure ()) t
-    Char.char '"'
-    pure ()
-  parseText = MegaparsecParser parseJSONText
-  parseBool = MegaparsecParser parseJSONBool
-  parseNumber = MegaparsecParser parseJSONNumber
-  parseNull = MegaparsecParser $ T.label "null literal" parseJSONNull
-  validateJSON (MegaparsecParser f) = MegaparsecParser $ do
-    r <- f
-    case r of
-      Left a -> fail (Text.unpack a)
-      Right a -> pure a
-
--- | Convert an abstract JSONParser to a Megaparsec parser.
-convertParserToMegaparsecParser :: (forall parser. JSONParser parser => parser a) -> Parser a
-convertParserToMegaparsecParser = getMegaparsecParser
-
--- | Get a megaparsec parser for your JSON value.
--- This parser will not construct any intermediate maps or other structures - your object will be parsed directly!
---
--- Note: this parser, until the ones that are built into the class, can consume whitespace at the start of the JSON.
-megaparsecParser :: (FromJSON val) => Parser val
-megaparsecParser = takeSpace *> getMegaparsecParser fromJSON
-
--- | Run an abstract JSONParser via Megaparsec.
-runParserViaMegaparsec :: (forall parser. JSONParser parser => parser a) -> Text.Text -> Either String a
-runParserViaMegaparsec p t =
-  case T.runParser (convertParserToMegaparsecParser p) "" t of
-    Left r -> Left $ T.errorBundlePretty r
-    Right k -> Right k
-
--- | Parse an object for which 'FromJSON' is defined via Megaparsec.
-parseViaMegaparsec :: forall val. (FromJSON val) => Text.Text -> Either String val
-parseViaMegaparsec = runParserViaMegaparsec fromJSON
diff --git a/lib/Jordan/FromJSON/ParseInternal.hs b/lib/Jordan/FromJSON/ParseInternal.hs
deleted file mode 100644
--- a/lib/Jordan/FromJSON/ParseInternal.hs
+++ /dev/null
@@ -1,120 +0,0 @@
-{-# LANGUAGE ApplicativeDo #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
--- | Module containing internal helpers for our parsers.
-module Jordan.FromJSON.ParseInternal
-    where
-
-import Control.Applicative (Alternative(..))
-import Data.Foldable (asum)
-
--- | A parser for permutations.
---
--- Based on the paper Parsing Permutation Phrases by
--- Arthur Baars, Andres Loh, and S. Doaitse Swierstra.
---
--- The source code for 'Control.Applicative.Permutations' really helped
--- in writing this, although this type is structured differently (and closer to the actual paper).
--- Thank you very much to Alex Washburn!
-data Permutation parser a
-  = Choice [Branch parser a]
-  -- ^ We have multiple options for how to parse further.
-  | Empty a
-  -- ^ We have reached the end and only have a single value.
-
--- | A branch of a permutation.
--- Permutation parsers work by building up the entire tree of
--- possible parsers, which is efficient in Haskell due to laziness.
-data Branch parser a
-  = forall arg. Branch (Permutation parser (arg -> a)) (parser arg)
-
-instance (Functor m) => Functor (Branch m) where
-  fmap f (Branch perm p) = Branch (fmap (f .) perm) p
-
-instance (Functor m) => Functor (Permutation m) where
-  fmap f = \case
-    Choice c -> Choice $ fmap f <$> c
-    Empty a -> Empty (f a)
-
-instance (Alternative m) => Applicative (Branch m) where
-  pure a = Branch (pure $ const a) (pure ())
-  (Branch permuteF argF) <*> (Branch permuteA argA) =
-    Branch (args <$> permuteF <*> permuteA) arguments
-      where
-        arguments = ((,) <$> argA <*> argF) <|> (flip (,) <$> argF <*> argA)
-        args :: (arg1 -> a -> b) -> (arg2 -> a) -> (arg2, arg1) -> b
-        args f a (aa, fa) = f fa (a aa)
-
-instance (Alternative m) => Applicative (Permutation m) where
-  pure = Empty
-  (Empty f) <*> (Empty a) = Empty $ f a
-  (Empty f) <*> (Choice choices) = Choice $ fmap f <$> choices
-  (Choice f) <*> (Empty a) = Choice $ fmap ($ a) <$> f
-  t1@(Choice bs1) <*> t2@(Choice bs2) = Choice (map ins2 bs1 ++ map ins1 bs2)
-    where
-      ins1 (Branch perm p) = Branch ((.) <$> t1 <*> perm) p
-      ins2 (Branch perm p) = Branch (flip <$> perm <*> t2) p
-
--- | Wrap up a permutation parser with two effects:
---
--- It will first interleave an infinite number of some effects, which represent parsing "junk" or unwanted fields.
--- At every stage of the permutation, we will first try to run the effect we want, and if it fails
--- we will try to run the "junk" effect instead, then try again.
---
--- We attempt to *intersperse* the second effect afterwards.
--- It adds a new effect between every effect.
--- This is used in parsing JSON to add commas.
-wrapEffect
-  :: forall m a b. (Alternative m)
-  => m b
-  -- ^ Consume a single, \"junk\" field.
-  -- Used to ignore JSON keys that we do not care about.
-  -> m b
-  -- ^ Consume a \"separator\" between items in the permutation.
-  -- This consumption is not done at the front of the permutation
-  -- or after the end of it.
-  -- This is used to parse commas between JSON fields.
-  -> Permutation m a
-  -- ^ The permutation parser to run.
-  -> m a
-  -- ^ The final parser.
-wrapEffect takeSingle effAfter (Empty a) = pure a
-wrapEffect takeSingle effAfter (Choice choices) = consumeMany
-  where
-    consumeMany
-      = asum (pars <$> choices)
-      -- Base case above: one of the choices of the permutation matched
-      <|> (takeSingle *> effAfter *> consumeMany)
-      -- Interleaving case: none of the choices of the permutation matched,
-      -- so run a "junk" effect, the separator, and try again.
-      -- Due to the recursion here we will do this infinitely until we either cannot
-      -- run the junk effect, *or* we have a field that matches one of the choices of the permutation.
-    runWithEffect :: Permutation m whatever -> m whatever
-    runWithEffect (Empty a) = pure a
-    runWithEffect (Choice choices) = effAfter *> consumeRec
-        where
-          consumeRec
-            = asum (pars <$> choices)
-            -- Run one of the effects from the permutation
-            <|> (takeSingle *> effAfter *> consumeRec)
-            -- Interleave a potentially infinite number of junk effects, with the separator effect between them.
-    pars :: Branch m whatever -> m whatever
-    pars (Branch perm arg) = do
-      a <- arg
-      rest <- runWithEffect perm
-      pure $ rest a
-
-asParser :: (Alternative f) => Permutation f a -> f a
-asParser (Empty a) = pure a
-asParser (Choice choices) = asum (pars <$> choices)
-    where
-      pars :: (Alternative f) => Branch f a -> f a
-      pars (Branch perm arg) = do
-        a <- arg
-        rest <- asParser perm
-        pure $ rest a
-
-asPermutation :: (Alternative f) => f a -> Permutation f a
-asPermutation p = Choice $ pure $ Branch (pure id) p
diff --git a/lib/Jordan/FromJSON/UnboxedReporting.hs b/lib/Jordan/FromJSON/UnboxedReporting.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/FromJSON/UnboxedReporting.hs
@@ -0,0 +1,246 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE NoMonomorphismRestriction #-}
+
+-- | Attempts to parse to either a result type or a direct report, by using a custom parser.
+-- This parser uses Haskell primops to try to avoid allocations.
+-- At the end of the day, it's not as fast as Attoparsec, but it's pretty dang fast.
+--
+-- We could not use Attoparsec directly due to the need for differnet error handling.
+-- Other libraries with correct error handling behavior do exist, but in order to keep the dependency footprint low,
+-- we rolled our own.
+module Jordan.FromJSON.UnboxedReporting (parseOrReportWith, parseOrReport) where
+
+import Control.Applicative (Alternative (empty, (<|>)))
+import Control.Applicative.Combinators (sepBy)
+import Control.Monad (when)
+import Data.Bifunctor
+import qualified Data.ByteString as BS
+import Data.ByteString.Unsafe as BS
+import Data.Char (chr, isControl, ord)
+import Data.Functor (void, ($>))
+import qualified Data.Map.Strict as Map
+import Data.Maybe (isJust)
+import Data.Monoid (Alt (..))
+import Data.Scientific (Scientific)
+import qualified Data.Scientific as Scientific
+import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8', encodeUtf8)
+import Data.Word (Word8)
+import Jordan.FromJSON.Class
+import Jordan.FromJSON.Internal.Attoparsec (bsToInteger)
+import Jordan.FromJSON.Internal.Permutation
+import Jordan.FromJSON.Internal.UnboxedParser as UP hiding (AccumE (..), AccumEL, AccumER)
+import Jordan.FromJSON.Internal.UnboxedReporting
+import Jordan.Types.Internal.AccumE (AccumE (AccumE))
+import Jordan.Types.JSONError
+  ( JSONArrayError (..),
+    JSONError
+      ( ErrorBadArray,
+        ErrorBadObject,
+        ErrorBadTextConstant,
+        ErrorBadType,
+        ErrorInvalidJSON,
+        ErrorMesage,
+        ErrorNoValue
+      ),
+    JSONObjectError (..),
+  )
+import Jordan.Types.JSONType (JSONType (..))
+import Numeric (showHex)
+
+newtype ReportingParser a = ReportingParser {runReportingParser :: UP.Parser JSONError a}
+  deriving (Functor) via (UP.Parser JSONError)
+  deriving (Semigroup) via (Alt (UP.Parser JSONError) a)
+
+newtype ReportingObjectParser a = ReportingObjectParser
+  {runReportingObjectParser :: Permutation (UP.Parser JSONObjectError) a}
+  deriving (Functor, Applicative) via (Permutation (UP.Parser JSONObjectError))
+
+newtype ReportingTupleParser a = ReportingTupleParser
+  {runReportingTupleParser :: Integer -> (Integer, UP.Parser JSONArrayError a)}
+
+instance Functor ReportingTupleParser where
+  fmap f (ReportingTupleParser cb) =
+    ReportingTupleParser $ \index -> second (f <$>) $ cb index
+
+instance Applicative ReportingTupleParser where
+  pure a = ReportingTupleParser (,pure a)
+  (ReportingTupleParser f) <*> (ReportingTupleParser a) =
+    ReportingTupleParser $ \index ->
+      let (index', fp) = f index
+          (index'', ap) = a index
+       in ( index'',
+            do
+              f' <- fp
+              when (index /= index' && index /= index'') comma
+              f' <$> ap
+          )
+
+toObjectParser :: T.Text -> Parser JSONError a -> ReportingObjectParser a
+toObjectParser field itemParser =
+  ReportingObjectParser $
+    asPermutationWithFailing parseKV failNoValue
+  where
+    failNoValue = do
+      r <- UP.peekRest
+      UP.failWith $
+        MkJSONObjectError $ Map.singleton field ErrorNoValue
+    parseKV = first (MkJSONObjectError . Map.singleton field) $ parseObjectKV field itemParser
+{-# INLINE toObjectParser #-}
+
+toObjectParserDef field itemParser def =
+  ReportingObjectParser $
+    asPermutationWithDefault parseKV def
+  where
+    parseKV = first (MkJSONObjectError . Map.singleton field) $ do
+      parseObjectKV field itemParser
+
+parseArrayInner :: UP.Parser JSONError a -> Integer -> UP.Parser JSONArrayError [a]
+parseArrayInner parse index =
+  ((:) <$> parseElem <*> ((comma *> parseArrayInner parse (index + 1)) <|> pure []))
+    <|> pure []
+  where
+    parseElem = first (MkJSONArrayError . Map.singleton index) parse
+{-# INLINE parseArrayInner #-}
+
+parseDictKey :: UP.Parser JSONError a -> UP.Parser JSONObjectError (T.Text, a)
+parseDictKey parseVal = do
+  key <- textParser
+  kvSep
+  val <- first (MkJSONObjectError . Map.singleton key) parseVal
+  pure (key, val)
+
+instance JSONTupleParser ReportingTupleParser where
+  consumeItemWith = \(ReportingParser itemParser) ->
+    ReportingTupleParser $
+      \index ->
+        (index + 1, first (MkJSONArrayError . Map.singleton index) itemParser)
+
+instance JSONObjectParser ReportingObjectParser where
+  parseFieldWith field = \(ReportingParser itemParser) ->
+    toObjectParser field itemParser
+  parseFieldWithDefault field = \(ReportingParser itemParser) def ->
+    toObjectParserDef field itemParser def
+
+instance JSONParser ReportingParser where
+  parseTuple (ReportingTupleParser tp) =
+    ReportingParser $ do
+      jt <- peekJSONType
+      case jt of
+        JSONTypeArray -> tuple
+        other -> skipWithFailure $ ErrorBadType JSONTypeArray other
+    where
+      tuple = do
+        startArray
+        let (_, arrayParse) = tp 0
+        arr <- first ErrorBadArray arrayParse
+        endArray
+        pure arr
+  {-# INLINE parseTuple #-}
+  parseTextConstant tc =
+    ReportingParser $ do
+      jt <- peekJSONType
+      case jt of
+        JSONTypeText -> textConstant
+        other -> skipWithFailure $ ErrorBadType JSONTypeText other
+    where
+      textConstant = do
+        r <- UP.specificWord 34
+        void (parseSpecificKeyAfterQuote tc) <|> do
+          r <- parseAfterQuote
+          UP.failWith (ErrorBadTextConstant tc r)
+  {-# INLINE parseTextConstant #-}
+  parseArrayWith (ReportingParser rp) =
+    ReportingParser $
+      array
+        <|> skipNullExpecting JSONTypeArray
+        <|> skipBoolExpecting JSONTypeArray
+        <|> skipTextExpecting JSONTypeArray
+        <|> skipNumberExpecting JSONTypeArray
+    where
+      array = do
+        startArray
+        arr <- first ErrorBadArray $ parseArrayInner rp 0
+        endArray
+        pure arr
+  {-# INLINE parseDictionary #-}
+  parseDictionary (ReportingParser dict) =
+    ReportingParser $ do
+      jt <- peekJSONType
+      case jt of
+        JSONTypeObject -> parseDict
+        other -> UP.asFailure $ skipAnything $> ErrorBadType JSONTypeObject other
+    where
+      parseDict = do
+        startBracket
+        r <- first ErrorBadObject $ parseDictKey dict `sepBy` comma
+        endBracket
+        pure r
+  parseObject (ReportingObjectParser permute) = ReportingParser $ do
+    r <- peekJSONType
+    case r of
+      JSONTypeObject -> po
+      other -> UP.asFailure $ skipAnything $> ErrorBadType JSONTypeObject other
+    where
+      po = first ErrorBadObject $ do
+        startBracket
+        a <-
+          wrapEffect
+            skipAnyKV
+            comma
+            permute
+        rest <- peekRest
+        endBracket <|> do
+          comma
+          skipAnyKV `sepByVoid` comma
+          endBracket
+        pure a
+  {-# INLINE parseObject #-}
+  parseNull =
+    ReportingParser $ do
+      jt <- peekJSONType
+      case jt of
+        JSONTypeNull -> nullParser
+        other -> skipWithFailure $ ErrorBadType JSONTypeNull other
+  {-# INLINE parseNull #-}
+  parseBool = ReportingParser $ do
+    jt <- peekJSONType
+    case jt of
+      JSONTypeBool -> boolParser
+      other -> skipWithFailure $ ErrorBadType JSONTypeBool other
+  {-# INLINE parseBool #-}
+  parseText = ReportingParser $ do
+    jt <- peekJSONType
+    case jt of
+      JSONTypeText -> textParser
+      other -> skipWithFailure $ ErrorBadType JSONTypeText other
+  {-# INLINE parseText #-}
+  parseNumber =
+    ReportingParser $ do
+      r <- peekJSONType
+      case r of
+        JSONTypeNumber -> scientific
+        other -> UP.asFailure $ skipAnything $> ErrorBadType JSONTypeNumber other
+  {-# INLINE parseNumber #-}
+  validateJSON (ReportingParser rp) =
+    ReportingParser $
+      lowerErr (fmap (first ErrorMesage) rp)
+  {-# INLINE validateJSON #-}
+
+parseOrReportWith ::
+  (forall parser. JSONParser parser => parser a) ->
+  BS.ByteString ->
+  Either JSONError a
+parseOrReportWith (ReportingParser rp) bs =
+  case UP.parseBS (UP.skipWhitespace *> rp) bs of
+    Nothing -> Left ErrorInvalidJSON
+    Just (AccumE r) -> r
+{-# INLINE parseOrReportWith #-}
+
+parseOrReport :: (FromJSON a) => BS.ByteString -> Either JSONError a
+parseOrReport = parseOrReportWith fromJSON
+{-# INLINE parseOrReport #-}
diff --git a/lib/Jordan/Generic/Options.hs b/lib/Jordan/Generic/Options.hs
--- a/lib/Jordan/Generic/Options.hs
+++ b/lib/Jordan/Generic/Options.hs
@@ -1,12 +1,83 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
-module Jordan.Generic.Options
-    where
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 
-import GHC.Generics (Generic)
+module Jordan.Generic.Options where
 
+import Data.Coerce
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Type.Bool
+import Data.Typeable (TypeRep, splitTyConApp, tyConModule, tyConName)
+import GHC.Exts (Constraint)
+import GHC.Generics
+import GHC.TypeLits
+
+type Representational (f :: * -> *) =
+  (forall a b. (Coercible a b) => Coercible (f a) (f b) :: Constraint)
+
 data SumTypeEncoding
   = TagVal
   | TagInField
   deriving (Show, Read, Eq, Ord, Bounded, Enum, Generic)
 
-newtype PartOfSum f a = PartOfSum { getPartOfSum :: f a }
+type family AllNullary cons where
+  AllNullary (C1 ('MetaCons _ _ 'False) (S1 ('MetaSel 'Nothing _ _ _) U1)) = True
+  AllNullary (a :+: b) = AllNullary a && AllNullary b
+  AllNullary _ = False
+
+newtype PartOfSum f a = MkPartOfSum {getPartOfSum :: f a}
+  deriving (Show, Read, Eq, Ord, Generic)
+
+-- | A newtype wrapper, designed to make it easier to derive ToJSON and FromJSON instances.
+-- The API of abstract JSON serializing is awkward due to the somewhat bad ergonomics of the
+-- 'Data.Functor.Contravariant.Divisible.Divisible' and (especially)
+-- 'Data.Functor.Contravariant.Divisible.Decidable' typeclasses.
+--
+-- In general, using @ -XDerivingVia @, @ -XDeriveGeneric @, @ -XDataKinds @ and this wrapper will make your life much easier.
+-- Unfortunately, due to a weird GHC quirk, you also need @ -XDerivingVia @.
+--
+-- That is, the following won't work, complaining about role errors:
+--
+-- @
+--  data PersonFilter = PersonFilter { filterFirstName :: Maybe Text, filterLastName :: Maybe Text }
+--    deriving (Show, Generic)
+--    deriving (ToJSON, FromJSON) via (WithOptions '[KeepNothingFields] PersonFilter)
+-- @
+--
+-- But this will:
+--
+-- @
+--  data PersonFilter = PersonFilter { filterFirstName :: Maybe Text, filterLastName :: Maybe Text }
+--    deriving (Show, Generic)
+--
+--  deriving via (WithOptions '[KeepNothingFields] PersonFilter) instance (ToJSON PersonFilter)
+--  deriving via (WithOptions '[KeepNothingFields] PersonFilter) instance (FromJSON PersonFilter)
+-- @
+newtype WithOptions (options :: [*]) a = WithOptions {getWithOptions :: a}
+  deriving (Show, Eq, Ord)
+
+-- | Newtype for use with GeneralizedNewtypeDeriving.
+-- Will have us omit Nothing fields for parsing and serializing.
+data OmitNothingFields = OmitNothingFields
+
+-- | Keep nothing fields.
+-- Will have us omit @ null @ when serializing Maybe types.
+data KeepNothingFields = KeepNothingFields
+
+fullyQualifyName ::
+  TypeRep ->
+  Text
+fullyQualifyName tr =
+  case splitTyConApp tr of
+    (tc, []) -> baseName tc
+    (tc, args) -> baseName tc <> "(" <> T.intercalate "," (fullyQualifyName <$> args) <> ")"
+  where
+    baseName tc = T.pack (tyConModule tc <> "." <> tyConName tc)
diff --git a/lib/Jordan/ToJSON/Builder.hs b/lib/Jordan/ToJSON/Builder.hs
--- a/lib/Jordan/ToJSON/Builder.hs
+++ b/lib/Jordan/ToJSON/Builder.hs
@@ -2,11 +2,13 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+
 module Jordan.ToJSON.Builder
-    ( JSONBuilder (..)
-    , toJSONViaBuilder
-    , toJSONAsBuilder
-    ) where
+  ( JSONBuilder (..),
+    toJSONViaBuilder,
+    toJSONAsBuilder,
+  )
+where
 
 import Data.ByteString.Builder (Builder, toLazyByteString)
 import qualified Data.ByteString.Builder.Prim as BP
@@ -23,8 +25,7 @@
 
 -- | JSON Serializer that makes use of 'Data.ByteString.Builder' to do its work.
 -- Should be really fast.
-newtype JSONBuilder a
-  = JSONBuilder { runJSONBuilder :: a -> Builder }
+newtype JSONBuilder a = JSONBuilder {runJSONBuilder :: a -> Builder}
   deriving (Semigroup, Monoid) via (a -> Builder)
 
 instance Contravariant JSONBuilder where
@@ -46,39 +47,41 @@
 runCommaSep Empty = ""
 runCommaSep (Written w) = w
 
-newtype JSONCommaBuilder a
-  = JSONCommaBuilder { runCommaBuilder :: a -> CommaSep }
+newtype JSONCommaBuilder a = JSONCommaBuilder {runCommaBuilder :: a -> CommaSep}
 
 -- Lifted from aeson (thanks to them!)
 ascii2 :: (Char, Char) -> BP.BoundedPrim a
 ascii2 cs = BP.liftFixedToBounded $ const cs BP.>$< BP.char7 BP.>*< BP.char7
 {-# INLINE ascii2 #-}
 
--- | Also lifted from Aeson (once again, thanks to them!)
+-- | Mostly lifted from Aeson (thanks to them).
 escapeAscii :: BP.BoundedPrim Word8
 escapeAscii =
-    BP.condB (== c2w '\\'  ) (ascii2 ('\\','\\')) $
-    BP.condB (== c2w '\"'  ) (ascii2 ('\\','"' )) $
-    BP.condB (>= c2w '\x20') (BP.liftFixedToBounded BP.word8) $
-    BP.condB (== c2w '\n'  ) (ascii2 ('\\','n' )) $
-    BP.condB (== c2w '\r'  ) (ascii2 ('\\','r' )) $
-    BP.condB (== c2w '\t'  ) (ascii2 ('\\','t' )) $
-    BP.liftFixedToBounded hexEscape -- fallback for chars < 0x20
+  -- Irritatingly we have a few non-control characters we need to escape,
+  -- so we try to do that first.
+  BP.condB (== 0x5c) (ascii2 ('\\', '\\')) $ -- a backslash
+    BP.condB (== 0x22) (ascii2 ('\\', '"')) $ -- a quote
+      BP.condB (>= 0x20) (BP.liftFixedToBounded BP.word8) $ -- Now, if we have an ordinal above 0x20, we can just encode directly
+        BP.condB (== 0x0a) (ascii2 ('\\', 'n')) $ -- Special control character \n
+          BP.condB (== 0x0d) (ascii2 ('\\', 'r')) $ -- special control character \r
+            BP.condB (== 0x09) (ascii2 ('\\', 't')) $ -- Special control character \t
+              BP.condB (== 0x0c) (ascii2 ('\\', 'f')) $ -- Special control character \f
+                BP.condB (== 0x08) (ascii2 ('\\', 'b')) $ -- Special control character \b
+                  BP.liftFixedToBounded hexEscape -- fallback for other control characters
   where
-    c2w :: Char -> Word8
-    c2w c = fromIntegral (ord c)
     hexEscape :: BP.FixedPrim Word8
-    hexEscape = (\c -> ('\\', ('u', fromIntegral c))) BP.>$<
-        BP.char8 BP.>*< BP.char8 BP.>*< BP.word16HexFixed
+    hexEscape =
+      (\c -> ('\\', ('u', ('0', ('0', c)))))
+        BP.>$< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.word8HexFixed
 {-# INLINE escapeAscii #-}
 
 -- | Make a builder for a quoted string, which does all the cool escaping crap we need to do.
 -- Mostly stolen shamelessly from Aeson.
-writeQuotedString :: Text -> Builder
-writeQuotedString t = "\"" <> encodeUtf8BuilderEscaped escapeAscii t <> "\""
+serializeQuotedString :: Text -> Builder
+serializeQuotedString t = "\"" <> encodeUtf8BuilderEscaped escapeAscii t <> "\""
 
-writeKV :: (a -> Builder) -> Text -> a -> Builder
-writeKV map k v = writeQuotedString k <> ": " <> map v
+serializeKV :: (a -> Builder) -> Text -> a -> Builder
+serializeKV map k v = serializeQuotedString k <> ": " <> map v
 
 instance Contravariant JSONCommaBuilder where
   contramap f (JSONCommaBuilder a) = JSONCommaBuilder $ a . f
@@ -90,11 +93,14 @@
       (b, c) -> runCommaBuilder sB b <> runCommaBuilder sC c
 
 instance JSONObjectSerializer JSONCommaBuilder where
-  writeField field (JSONBuilder a) = JSONCommaBuilder $ \arg ->
-    Written $ writeQuotedString field <> ": " <> a arg
+  serializeFieldWith field (JSONBuilder a) = JSONCommaBuilder $ \arg ->
+    Written $ serializeQuotedString field <> ": " <> a arg
+  serializeJust field (JSONBuilder a) = JSONCommaBuilder $ \case
+    Nothing -> Empty
+    Just a' -> Written $ serializeQuotedString field <> ": " <> a a'
 
 instance JSONTupleSerializer JSONCommaBuilder where
-  writeItem (JSONBuilder a) = JSONCommaBuilder $ Written . a
+  serializeItemWith (JSONBuilder a) = JSONCommaBuilder $ Written . a
 
 instance Selectable JSONBuilder where
   giveUp f = JSONBuilder $ \a -> absurd (f a)
@@ -104,7 +110,7 @@
       Right rhs -> runJSONBuilder serR rhs
 
 instance JSONSerializer JSONBuilder where
-  serializeObject _ (JSONCommaBuilder f) = JSONBuilder $ \a ->
+  serializeObject (JSONCommaBuilder f) = JSONBuilder $ \a ->
     case f a of
       Written bu -> "{" <> bu <> "}"
       Empty -> "{}"
@@ -113,9 +119,9 @@
       Written bu -> "[" <> bu <> "]"
       Empty -> "[]"
   serializeDictionary (JSONBuilder t) = JSONBuilder $ \a ->
-    "{" <> runCommaSep (foldMap (\(k,v) -> Written (writeKV t k v)) a) <> "}"
-  serializeText = JSONBuilder $ \t -> writeQuotedString t
-  serializeTextConstant = JSONBuilder . const . writeQuotedString
+    "{" <> runCommaSep (foldMap (\(k, v) -> Written (serializeKV t k v)) a) <> "}"
+  serializeText = JSONBuilder $ \t -> serializeQuotedString t
+  serializeTextConstant = JSONBuilder . const . serializeQuotedString
   serializeNumber = JSONBuilder $ \a -> scientificBuilder a
   serializeNull = JSONBuilder $ const "null"
   serializeBool = JSONBuilder $ \case
diff --git a/lib/Jordan/ToJSON/Class.hs b/lib/Jordan/ToJSON/Class.hs
--- a/lib/Jordan/ToJSON/Class.hs
+++ b/lib/Jordan/ToJSON/Class.hs
@@ -1,29 +1,37 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
-module Jordan.ToJSON.Class
-    where
 
+module Jordan.ToJSON.Class where
+
+import Data.Foldable (fold)
 import Data.Functor.Contravariant
 import Data.Functor.Contravariant.Divisible
+import Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import qualified Data.Ratio as Ratio
-import Data.Scientific (Scientific)
+import Data.Scientific
 import qualified Data.Scientific as Sci
 import qualified Data.Semigroup as Semi
-import Data.Text (Text)
+import qualified Data.Set as Set
+import Data.Text (Text, pack)
 import qualified Data.Text as T
-import Data.Typeable (Proxy(..), Typeable, tyConModule, tyConName, typeRep, typeRepTyCon)
+import Data.Typeable (Proxy (..), TypeRep, Typeable, splitTyConApp, tyConModule, tyConName, typeRep, typeRepTyCon)
 import Data.Void (Void, absurd)
 import GHC.Generics
+import GHC.TypeLits (KnownSymbol, symbolVal)
 import Jordan.Generic.Options
 
 -- | Basically just 'Data.Functor.Contravariant.Divisible.Decidable' but without
@@ -38,9 +46,13 @@
 class (Contravariant f) => Selectable f where
   -- | Give up trying to decide.
   giveUp :: (arg -> Void) -> f arg
+
   -- | Pick one thing, or another, as long as you can serialize both options.
   select :: (arg -> Either lhs rhs) -> f lhs -> f rhs -> f arg
 
+selected :: (Selectable f) => f lhs -> f rhs -> f (Either lhs rhs)
+selected = select id
+
 -- | An abstract representation of how to serialize a JSON object.
 -- Since serializing is the exact opposite of parsing, we have to be
 -- 'Data.Functor.Contravariant.Decidable' instead of 'Control.Applicative.Alternative'.
@@ -51,57 +63,87 @@
 -- the combinators for putting things together, and involve a lot of tuples everywhere.
 --
 -- Thankfully we provide a good interface to derive these classes generically!
-class (Divisible f) => JSONObjectSerializer f where
-  writeField
-    :: Text
-    -- ^ Label for the field to write
-    -> (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a)
-    -- ^ How to write the field.
+class (Divisible f, Representational f) => JSONObjectSerializer f where
+  serializeFieldWith ::
+    -- | Label for the field to serialize
+    Text ->
+    -- | How to serialize the field.
     -- The forall ensures that JSON serialization is kept completely abstract.
     -- You can only use the methods of 'JSONSerializer' here.
-    -> f a
+    (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a) ->
+    f a
+  serializeField :: (ToJSON a) => Text -> f a
+  serializeField t = serializeFieldWith t toJSON
+  serializeDescribeFieldWith ::
+    -- | Field key to serialize.
+    Text ->
+    -- | Field description.
+    Text ->
+    -- | Serializer for the field.
+    (forall valueSerializer. JSONSerializer valueSerializer => valueSerializer a) ->
+    f a
+  serializeDescribeFieldWith t _ = serializeFieldWith t
 
-class (Divisible f) => JSONTupleSerializer f where
-  writeItem
-    :: (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a)
-    -- ^ Write a single item into the tuple.
+  -- | Write if we have Just a value. Do not add the field otherwise.
+  serializeJust ::
+    -- | Label for the field to serialize
+    Text ->
+    -- | Serializer for Just
+    (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a) ->
+    f (Maybe a)
+
+class (Divisible f, Representational f) => JSONTupleSerializer f where
+  serializeItemWith ::
+    -- | Write a single item into the tuple.
     -- The forall keeps things abstract.
-    -> f a
+    (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a) ->
+    f a
+  serializeItem ::
+    (ToJSON a) => f a
+  serializeItem = serializeItemWith toJSON
 
 -- | An abstract representation of how to serialize a Haskell value into JSON.
-class (Selectable f) => JSONSerializer f where
-  serializeObject
-    :: Text
-    -- ^ A name for the object. Should be "globally unique" as much as possible.
-    -> (forall objSerializer. JSONObjectSerializer objSerializer => objSerializer a)
-    -- ^ How to serialize the object.
+class (Selectable f, Representational f) => JSONSerializer f where
+  serializeObject ::
+    -- | How to serialize the object.
     -- The forall here keeps things abstract: you are only allowed to use the methods of 'JSONObjectSerializer' here.
-    -> f a
-  serializeDictionary
-    :: (Foldable t)
-    => (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a)
-    -> f (t (Text, a))
-  serializeText
-    :: f Text
+    (forall objSerializer. JSONObjectSerializer objSerializer => objSerializer a) ->
+    f a
+  serializeDictionary ::
+    (Foldable t) =>
+    (forall jsonSerializer. JSONSerializer jsonSerializer => jsonSerializer a) ->
+    f (t (Text, a))
+  serializeText ::
+    f Text
+
   -- | Serialize some text constant.
   -- Note that this returns a serializer of anything: if you are always going to serialize out the same string,
   -- we don't need to even look at the thing we\'re serializing!
-  serializeTextConstant
-    :: Text
-    -> f a
-  serializeNull
-    :: f any
-  serializeNumber
-    :: f Scientific
-  serializeBool
-    :: f Bool
-  serializeTuple
-    :: (forall tupleSerializer. JSONTupleSerializer tupleSerializer => tupleSerializer a)
-    -> f a
-  serializeArray
-    :: (ToJSON a)
-    => f [a]
+  serializeTextConstant ::
+    Text ->
+    f a
 
+  serializeNull ::
+    f any
+  serializeNumber ::
+    f Scientific
+  serializeBool ::
+    f Bool
+  serializeTuple ::
+    (forall tupleSerializer. JSONTupleSerializer tupleSerializer => tupleSerializer a) ->
+    f a
+  serializeArray ::
+    (ToJSON a) =>
+    f [a]
+
+  -- | Give a name to a serializer.
+  -- Should be globally unique, if possible.
+  nameSerializer ::
+    Text ->
+    f a ->
+    f a
+  nameSerializer _ a = a
+
 -- | A class to provide the canonical way to encode a JSON.
 --
 -- This class uses finally tagless style to keep the instructions for serializing abstract.
@@ -109,11 +151,36 @@
 --
 -- This class is derivable generically, and will generate a \"nice\" format.
 -- In my opinion, at least.
+--
+-- If you want to customize this JSON, the newtype 'WithOptions' can be helpful, as it allows you to specify options for the generic serialization.
+-- Unfortunately, due to a weird GHC quirk, you need to use it with @ -XStandaloneDeriving @ as well as @ -XDerivingVia @.
+-- That is, you should write:
+--
+--
+-- @
+-- data PersonFilter = PersonFilter { filterFirstName :: Maybe Text, filterLastName :: Maybe Text }
+--   deriving (Show, Read, Eq, Ord, Generic)
+--
+-- deriving via (WithOptions '[KeepNothingFields] PersonFilter) instance (ToJSON PersonFilter)
+-- @
+
+---- === __Laws__
+--
+-- This instance is lawless, unless 'Jordan.FromJSON.Class.FromJSON' is also defined for this type.
+-- In that case, the representation serialized by 'ToJSON' should match that of the representation parsed by
+-- 'Jordan.FromJSON.Class.FromJSON'.
 class ToJSON v where
-  toJSON :: (JSONSerializer f) => f v
-  default toJSON :: (Generic v, GToJSON (Rep v)) => (JSONSerializer f) => f v
-  toJSON = contramap from $ gToJSON defaultToJSONOptions
+  toJSON :: (forall f. (JSONSerializer f) => f v)
+  default toJSON :: (Generic v, GToJSON (Rep v), Typeable v) => (JSONSerializer f) => f v
+  toJSON = contramap from $ gToJSON defaultToJSONOptions {toJSONBaseName = fq}
+    where
+      fq = T.unpack $ fullyQualifyName $ typeRep (Proxy :: Proxy v)
 
+instance (Generic a, GToJSON (Rep a), Typeable a, SpecifiesToJSONOptions options) => ToJSON (WithOptions options a) where
+  toJSON = contramap getWithOptions . contramap from $ gToJSON (specifiedToJSONOptions @options) {toJSONBaseName = fq}
+    where
+      fq = T.unpack $ fullyQualifyName $ typeRep (Proxy :: Proxy a)
+
 instance ToJSON () where
   toJSON = serializeNull
 
@@ -155,13 +222,14 @@
   toJSON = contramap T.pack serializeText
 
 instance forall a. (ToJSON a, Typeable a) => ToJSON (Ratio.Ratio a) where
-  toJSON = serializeObject objName $
-    divide divider (writeField "num" toJSON) (writeField "denom" toJSON)
+  toJSON =
+    serializeObject $
+      divide divider (serializeField "num") (serializeField "denom")
     where
-        divider :: Ratio.Ratio a -> (a,a)
-        divider = (,) <$> Ratio.numerator <*> Ratio.denominator
-        objName = T.pack $ tyName <> ".Ratio"
-        tyName = (tyConModule <> const "." <> tyConName) $ typeRepTyCon $ typeRep (Proxy :: Proxy a)
+      divider :: Ratio.Ratio a -> (a, a)
+      divider = (,) <$> Ratio.numerator <*> Ratio.denominator
+      objName = T.pack $ tyName <> ".Ratio"
+      tyName = (tyConModule <> const "." <> tyConName) $ typeRepTyCon $ typeRep (Proxy :: Proxy a)
 
 instance (ToJSON a) => ToJSON (Semi.Min a) where
   toJSON = contramap Semi.getMin toJSON
@@ -193,97 +261,166 @@
 instance (ToJSON a) => ToJSON (Map.Map Text a) where
   toJSON = contramap Map.toList $ serializeDictionary toJSON
 
-data ToJSONOptions
-  = ToJSONOptions
-  { toJSONEncodeSums :: SumTypeEncoding
-  , toJSONBaseName :: String
-  , toJSONRenderEnum :: String -> String
+instance (ToJSON a) => ToJSON (Map.Map Integer a) where
+  toJSON = contramap (fmap toTextKey . Map.toList) $ serializeDictionary toJSON
+    where
+      toTextKey (key, value) = (pack $ show key, value)
+
+instance (ToJSON a) => ToJSON (NE.NonEmpty a) where
+  toJSON = contramap NE.toList serializeArray
+
+instance (ToJSON a) => ToJSON (Set.Set a) where
+  toJSON = contramap Set.toList serializeArray
+
+data ToJSONOptions = ToJSONOptions
+  { toJSONEncodeSums :: SumTypeEncoding,
+    toJSONBaseName :: String,
+    toJSONRenderEnum :: String -> String,
+    toJSONOmitNothingFields :: Bool
   }
 
 defaultToJSONOptions :: ToJSONOptions
-defaultToJSONOptions
-  = ToJSONOptions TagInField "" id
+defaultToJSONOptions =
+  ToJSONOptions TagInField "" id True
 
+class SpecifiesToJSONOptions (a :: [*]) where
+  specifiedToJSONOptions :: ToJSONOptions
+
+instance SpecifiesToJSONOptions '[] where
+  specifiedToJSONOptions = defaultToJSONOptions
+
+instance
+  (SpecifiesToJSONOptions xs) =>
+  SpecifiesToJSONOptions (OmitNothingFields ': xs)
+  where
+  specifiedToJSONOptions = (specifiedToJSONOptions @xs) {toJSONOmitNothingFields = True}
+
+instance
+  (SpecifiesToJSONOptions xs) =>
+  SpecifiesToJSONOptions (KeepNothingFields ': xs)
+  where
+  specifiedToJSONOptions =
+    (specifiedToJSONOptions @xs) {toJSONOmitNothingFields = False}
+
 class GToJSON v where
   gToJSON :: (JSONSerializer s) => ToJSONOptions -> s (v a)
 
+-- | Top-level metadata is ignored.
 instance (ToJSON c) => GToJSON (K1 i c) where
   gToJSON _ = contramap (\(K1 a) -> a) toJSON
 
+-- | Datatype metadata: we name the overall datatype with the baseName
+-- passed in the options, then serialize the inner information.
 instance (GToJSON f, Datatype t) => GToJSON (D1 t f) where
-  gToJSON = contramap (\(M1 a) -> a) . gToJSON . addName
+  gToJSON opts = nameSerializer (T.pack $ toJSONBaseName opts) $ contramap (\(M1 a) -> a) $ gToJSON opts
+
+-- | Serialize out a no-argument constructor via a string value of its name.
+-- This allows us to serialize out enum keys more easily.
+--
+-- This does not get a unique name as recursion cannot happen.
+instance {-# OVERLAPS #-} (KnownSymbol name) => GToJSON (C1 (MetaCons name fixity 'False) U1) where
+  gToJSON opts =
+    serializeTextConstant (T.pack connNameS)
     where
-      addName b = b { toJSONBaseName = toJSONBaseName b <> dtname }
-      dtname = moduleName s <> "." <> datatypeName s
-      s :: D1 t f a
-      s = undefined
+      connNameS = symbolVal (Proxy :: Proxy name)
 
-instance {-# OVERLAPS #-} (Constructor t) => GToJSON (PartOfSum (C1 t U1)) where
-  gToJSON opts = contramap getPartOfSum $ serializeTextConstant enumValue
+instance {-# OVERLAPS #-} (KnownSymbol name) => GToJSON (PartOfSum (C1 (MetaCons name fixity 'False) U1)) where
+  gToJSON = contramap getPartOfSum . gToJSON
+
+-- | IF we have a constructor with arguments, but not selectors, then
+-- we serialize as a tuple.
+instance {-# OVERLAPPABLE #-} (GToJSONTuple inner, Constructor (MetaCons n s 'False)) => GToJSON (C1 (MetaCons n s 'False) inner) where
+  gToJSON opts =
+    contramap (\(M1 a) -> a) $
+      serializeTuple $ gToJSONTuple opts
+
+-- | If we have a constructor with arguments AND selectors (IE, a record), then
+-- we serialize out a JSON object.
+instance {-# OVERLAPPABLE #-} (GToJSONObject inner, Constructor (MetaCons n s 'True)) => GToJSON (C1 (MetaCons n s 'True) inner) where
+  gToJSON opts =
+    contramap (\(M1 a) -> a) $
+      serializeObject $
+        gToJSONObject opts
     where
-      enumValue = T.pack $ toJSONRenderEnum opts $ conName (undefined :: C1 t U1 f)
+      name = T.pack $ toJSONBaseName opts <> "." <> conName (undefined :: C1 (MetaCons n s 'True) inner a)
 
+-- | If we have a single-argument constructor with no selectors, we want to just parse it directly.
+instance {-# OVERLAPS #-} (ToJSON i) => GToJSON (C1 (MetaCons n s 'False) (S1 (MetaSel 'Nothing su ss ds) (Rec0 i))) where
+  gToJSON _ = contramap (\(M1 (M1 (K1 s))) -> s) toJSON
+
+-- | When rendering a sum type, and this is NOT an enum value, render via
+-- the sum encoding option the user provided.
 instance {-# OVERLAPPABLE #-} (Constructor t, GToJSON (C1 t f)) => GToJSON (PartOfSum (C1 t f)) where
   gToJSON opts = contramap getPartOfSum encoded
     where
       encoded = case toJSONEncodeSums opts of
         TagVal -> tagged
         TagInField -> field
-      field = serializeObject objName $
-        writeField cn (gToJSON opts)
-      tagged = serializeObject objName $
-        contramap ((),) $
-          divided
-            (writeField "key" $ serializeTextConstant cn)
-            (writeField "value" $ gToJSON opts)
+      field =
+        serializeObject $
+          serializeFieldWith cn (gToJSON opts)
+      tagged =
+        serializeObject $
+          contramap ((),) $
+            divided
+              (serializeFieldWith "key" $ serializeTextConstant cn)
+              (serializeFieldWith "value" $ gToJSON opts)
       objName = T.pack (toJSONBaseName opts) <> "." <> cn <> ".Output"
-      cn =  T.pack $ conName (undefined :: C1 t f a)
+      cn = T.pack $ conName (undefined :: C1 t f a)
 
 sumToEither :: (l :+: r) a -> Either (l a) (r a)
 sumToEither f = case f of
   L1 a -> Left a
   R1 a -> Right a
 
+-- | If we can serialize out both sides of a sum-type, we can serialize out the sum type.
 instance forall l r. (GToJSON (PartOfSum l), GToJSON (PartOfSum r)) => GToJSON (l :+: r) where
   gToJSON :: forall f a. (JSONSerializer f) => ToJSONOptions -> f ((l :+: r) a)
   gToJSON opts =
     select
       sumToEither
-      (contramap PartOfSum $ gToJSON opts)
-      (contramap PartOfSum $ gToJSON opts)
+      (contramap MkPartOfSum $ gToJSON opts)
+      (contramap MkPartOfSum $ gToJSON opts)
 
 instance (GToJSON (PartOfSum l), GToJSON (PartOfSum r)) => GToJSON (PartOfSum (l :+: r)) where
   gToJSON opts = contramap getPartOfSum (gToJSON opts)
 
-instance (GToJSON s) => GToJSON (S1 whatever s) where
-  gToJSON = contramap (\(M1 a) -> a) . gToJSON
-
 instance GToJSON V1 where
   gToJSON _ = giveUp (error "how the hell did you construct a void data type?")
 
+-- | Type class for generically converting to a JSON object.
+-- We can do this if all the fields under a constructor are named.
 class GToJSONObject v where
   gToJSONObject :: (JSONObjectSerializer f) => ToJSONOptions -> f (v a)
 
-instance (GToJSON f, Selector t) => GToJSONObject (S1 t f) where
-  gToJSONObject o
-    = contramap (\(M1 a) -> a)
-    $ writeField (T.pack $ selName v) (gToJSON o)
-      where
-        v :: M1 S t f a
-        v = undefined
+instance {-# OVERLAPPABLE #-} (GToJSON f, KnownSymbol selector) => GToJSONObject (S1 (MetaSel (Just selector) su ss ds) f) where
+  gToJSONObject o =
+    contramap (\(M1 a) -> a) $
+      serializeFieldWith (T.pack $ symbolVal (Proxy :: Proxy selector)) (gToJSON o)
 
+instance {-# OVERLAPS #-} (ToJSON a, KnownSymbol selector) => GToJSONObject (S1 (MetaSel (Just selector) su ss ds) (Rec0 (Maybe a))) where
+  gToJSONObject o = contramap map fieldWriter
+    where
+      fieldWriter
+        | toJSONOmitNothingFields o = serializeJust name toJSON
+        | otherwise = serializeFieldWith name toJSON
+      map (M1 (K1 a)) = a
+      name = T.pack $ symbolVal (Proxy :: Proxy selector)
+
 instance (GToJSONObject lhs, GToJSONObject rhs) => GToJSONObject (lhs :*: rhs) where
   gToJSONObject o = divide div (gToJSONObject o) (gToJSONObject o)
     where
-      div (a :*: b) = (a,b)
+      div (a :*: b) = (a, b)
 
-instance {-# OVERLAPPABLE #-} (GToJSONObject inner, Constructor t) => GToJSON (C1 t inner) where
-  gToJSON opts
-    = contramap (\(M1 a) -> a)
-    $ serializeObject name
-    $ gToJSONObject opts
+class GToJSONTuple v where
+  gToJSONTuple :: (JSONTupleSerializer f) => ToJSONOptions -> f (v a)
+
+instance (GToJSONTuple lhs, GToJSONTuple rhs) => GToJSONTuple (lhs :*: rhs) where
+  gToJSONTuple o = divide div (gToJSONTuple o) (gToJSONTuple o)
     where
-      name = T.pack $ toJSONBaseName opts <> "." <> conName (undefined :: C1 t inner a) <> ".Output"
+      div (a :*: b) = (a, b)
 
-instance {-# OVERLAPS #-} (ToJSON i) => GToJSON (C1 c (S1 (MetaSel 'Nothing su ss ds) (Rec0 i))) where
-  gToJSON _ = contramap (\(M1 (M1 (K1 s))) -> s) toJSON
+instance (GToJSON f) => GToJSONTuple (S1 (MetaSel Nothing su ss ds) f) where
+  gToJSONTuple o =
+    contramap (\(M1 a) -> a) $
+      serializeItemWith (gToJSON o)
diff --git a/lib/Jordan/ToJSON/Text.hs b/lib/Jordan/ToJSON/Text.hs
deleted file mode 100644
--- a/lib/Jordan/ToJSON/Text.hs
+++ /dev/null
@@ -1,142 +0,0 @@
-{-# LANGUAGE DerivingVia #-}
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-module Jordan.ToJSON.Text
-    where
-
-import Data.Functor.Contravariant
-import Data.Functor.Contravariant.Divisible
-import Data.List (intersperse)
-import qualified Data.Scientific as Sci
-import Data.Semigroup (Endo(..))
-import Data.String (IsString(..))
-import qualified Data.Text as T
-import Data.Void (absurd)
-import Jordan.ToJSON.Class
-
-data TextComma
-  = Written (T.Text -> T.Text)
-  | Empty
-
-runWritten :: TextComma -> T.Text -> T.Text
-runWritten Empty = id
-runWritten (Written f) = f
-
-instance IsString TextComma where
-  fromString s = Written (<> T.pack s)
-
-instance Semigroup TextComma where
-  Empty <> a = a
-  a <> Empty = a
-  (Written f) <> (Written f') = Written (f . (", " <>) . f')
-
-instance Monoid TextComma where
-  mempty = Empty
-
-newtype CommaBuilder v = CommaBuilder { runCommaBuilder :: v -> TextComma }
-  deriving (Semigroup, Monoid) via (v -> TextComma)
-
-runCommaBuilder' :: CommaBuilder v -> v -> T.Text -> T.Text
-runCommaBuilder' (CommaBuilder f) = runWritten . f
-
-instance Contravariant CommaBuilder where
-  contramap f (CommaBuilder v) = CommaBuilder (v . f)
-
-instance Divisible CommaBuilder where
-  conquer = CommaBuilder (const Empty)
-  divide d (CommaBuilder b) (CommaBuilder c) = CommaBuilder $ \a ->
-    let (b', c') = d a in b b' <> c c'
-
-newtype TextArray v = TextArray { runTextArray :: v -> ([T.Text] -> [T.Text]) }
-  deriving (Semigroup, Monoid) via (v -> Endo [T.Text])
-
-instance Contravariant TextArray where
-  contramap f (TextArray b) = TextArray $ \a -> b (f a)
-
-instance Divisible TextArray where
-  conquer = TextArray $ const mempty
-  divide d (TextArray b) (TextArray c) = TextArray $ \a ->
-    let (b', c') = d a in b b' . c c'
-
-instance Decidable TextArray where
-  lose _ = TextArray $ const mempty
-  choose f (TextArray b) (TextArray c) = TextArray $ \a ->
-    case f a of
-      Left b'  -> b b'
-      Right c' -> c c'
-
-instance JSONTupleSerializer CommaBuilder where
-  writeItem f = CommaBuilder $ Written . runJSONText f
-
-instance JSONObjectSerializer CommaBuilder where
-  writeField t s = CommaBuilder $ \arg ->
-    Written (quoteString t . (": " <> ) . runJSONText s arg)
-
-instance JSONTupleSerializer TextArray where
-  writeItem f = TextArray $ \a -> ([runJSONText f a ""] <>)
-
-newtype JSONText a
-  = JSONText { runJSONText :: a -> (T.Text -> T.Text) }
-  deriving (Semigroup, Monoid) via (a -> Endo T.Text)
-
-instance Contravariant JSONText where
-  contramap f (JSONText s) = JSONText (s . f)
-
-instance Selectable JSONText where
-  giveUp f = JSONText $ \a -> absurd (f a)
-  select f (JSONText lhs) (JSONText rhs) = JSONText $ either lhs rhs . f
-
-convChar :: Char -> (T.Text -> T.Text)
-convChar = \case
-  '\b' -> ("\\b" <>)
-  '\f' -> ("\\f" <>)
-  '\n' -> ("\\n" <>)
-  '\r' -> ("\\r" <>)
-  '\t' -> ("\\t" <>)
-  '"' -> ("\\\"" <>)
-  '\\' -> ("\\\\" <>)
-  o -> (T.singleton o <>)
-
-isBadChar :: Char -> Bool
-isBadChar = \case
-  '\b' -> True
-  '\f' -> True
-  '\r' -> True
-  '\t' -> True
-  '\\' -> True
-  '"' -> True
-  _ -> False
-
-quoteString :: T.Text -> (T.Text -> T.Text)
-quoteString t = ("\"" <>) . innerText . ("\"" <>)
-  where
-    innerText
-      | T.any isBadChar t = T.foldl' (\o a -> o . convChar a) id t
-      | otherwise = (t <>)
-
-sArray :: (a -> T.Text -> T.Text) -> [a] -> (T.Text -> T.Text)
-sArray _ [] = id
-sArray f [x] = f x
-sArray f (x : xs) = f x . ("," <>) . sArray f xs
-
-instance JSONSerializer JSONText where
-  serializeNull = JSONText $ const ("null" <>)
-  serializeText = JSONText $ \a -> quoteString a
-  serializeTextConstant t = JSONText $ const $ quoteString t
-  serializeNumber = JSONText $ \n ->
-    ((T.pack $ Sci.formatScientific Sci.Generic Nothing n) <>)
-  serializeDictionary (JSONText serItem) = JSONText $ \n ->
-    ("{" <>) . keys n . ("}" <>)
-      where
-        keys v = runWritten $ foldMap (\(k, v) -> Written $ quoteString k . (": " <> ) . serItem v) v
-  serializeBool = JSONText $ \a -> ((if a then "true" else "false") <>)
-  serializeObject n obj = JSONText $ \arg ->
-    ("{" <>) . runCommaBuilder' obj arg . ("}" <>)
-  serializeTuple obj = JSONText $ \arg ->
-    ("[" <>) . runCommaBuilder' obj arg . ("}" <>)
-  serializeArray = JSONText $ \a -> ("[" <>) . sArray (runJSONText toJSON) a . (<> "]")
-
-toJSONText :: (ToJSON a) => a -> T.Text
-toJSONText a = runJSONText toJSON a ""
diff --git a/lib/Jordan/Types/Internal/AccumE.hs b/lib/Jordan/Types/Internal/AccumE.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/Types/Internal/AccumE.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+-- | Either, but with an Applicative instance that combines errors via '<>'.
+--
+-- This is sometimes known as the validation Applicative.
+-- There are Haskell packages providing this type, however, in the interest of minimized
+-- dependency footprint we use this.
+module Jordan.Types.Internal.AccumE
+  ( AccumE
+      ( AccumE,
+        getAccumE,
+        AccumEL,
+        AccumER
+      ),
+  )
+where
+
+import Control.Applicative
+import Data.Bifunctor
+import GHC.Generics
+import Text.Read
+
+-- | A version of Either that accumulates errors via an instance of 'Semigroup'.
+--
+-- This is sometimes called the validation applicative.
+newtype AccumE err val = AccumE {getAccumE :: Either err val}
+  deriving (Functor) via Either err
+  deriving (Bifunctor) via Either
+  deriving (Generic)
+
+-- | Show instance uses the 'AccumER' and 'AccumEL' pattern synonyms.
+instance (Show a, Show b) => Show (AccumE a b) where
+  showsPrec prec = \case
+    AccumEL l ->
+      showParen (prec > 10) $
+        showString "AccumEL " . showsPrec 11 l
+    AccumER r ->
+      showParen (prec > 10) $
+        showString "AccumER " . showsPrec 11 r
+
+-- | Read instance uses the 'AccumER' and 'AccumEL' pattern synonyms.
+instance (Read a, Read b) => Read (AccumE a b) where
+  readPrec = parens $ left +++ right
+    where
+      left = do
+        Ident "AccumEL" <- lexP
+        AccumEL <$> step readPrec
+      right = do
+        Ident "AccumER" <- lexP
+        AccumER <$> step readPrec
+
+-- | Construct an error value.
+pattern AccumEL :: err -> AccumE err val
+pattern AccumEL l = AccumE (Left l)
+
+-- | Construct a good value.
+-- Equivalent to 'pure'.
+pattern AccumER :: val -> AccumE err val
+pattern AccumER r = AccumE (Right r)
+
+{-# COMPLETE AccumEL, AccumER #-}
+
+-- | Applicative accumulates errors.
+--
+-- Note that this is *strict* in the error, because this
+-- can sometimes reduce the number of allocations in the places
+-- where we use this.
+instance (Semigroup e) => Applicative (AccumE e) where
+  pure !a = AccumE (Right a)
+  {-# INLINE pure #-}
+  (AccumE !f) <*> (AccumE !a) = AccumE $ case f of
+    Left !e -> case a of
+      Left !e' -> Left $ e <> e'
+      Right !a' -> Left e
+    Right !fab -> case a of
+      Left !e -> Left e
+      Right !arg -> Right $ fab arg
+  {-# INLINE (<*>) #-}
+  liftA2 f (AccumE arg) (AccumE arg') =
+    AccumE
+      ( case arg of
+          Left e -> case arg' of
+            Left e' -> Left $ e <> e'
+            Right b -> Left e
+          Right a -> case arg' of
+            Left e -> Left e
+            Right b -> Right (f a b)
+      )
+  {-# INLINE liftA2 #-}
+
+-- | Alternative takes the first result if there is a result.
+-- If there is not, will *not* accumulate errors.
+instance (Monoid m) => Alternative (AccumE m) where
+  empty = AccumEL mempty
+  (AccumER a) <|> _ = AccumER a
+  (AccumEL _) <|> (AccumER a) = AccumER a
+  (AccumEL a) <|> (AccumEL _) = AccumEL a
+  {-# INLINE (<|>) #-}
+
+-- | Semigroup accumulates errors if both are errors, otherwise
+-- it returns the first good value.
+instance (Semigroup e) => Semigroup (AccumE e a) where
+  (AccumE lhs) <> (AccumE rhs) = AccumE $ case lhs of
+    Left e -> case rhs of
+      Left e' -> Left $ e <> e'
+      Right a -> Right a
+    Right a -> Right a
+
+-- mempty is an error with 'mempty'
+instance (Monoid err) => Monoid (AccumE err a) where
+  mempty = AccumEL mempty
diff --git a/lib/Jordan/Types/Internal/MergeMap.hs b/lib/Jordan/Types/Internal/MergeMap.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/Types/Internal/MergeMap.hs
@@ -0,0 +1,28 @@
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+-- | Provides a MergeMap, which is basically a map with
+module Jordan.Types.Internal.MergeMap where
+
+import qualified Data.Map as Map
+import GHC.Exts (IsList (..))
+
+-- | A map where '<>' merges values with '<>'.
+newtype MergeMap key val = MergeMap {getMergeMap :: Map.Map key val}
+  deriving (Eq)
+  deriving (IsList) via (Map.Map key val)
+  deriving (Functor, Foldable) via (Map.Map key)
+
+instance Traversable (MergeMap key) where
+  traverse f (MergeMap m) = MergeMap <$> traverse f m
+
+instance (Semigroup val, Ord key) => Semigroup (MergeMap key val) where
+  (MergeMap lhs) <> (MergeMap rhs) = MergeMap $ Map.unionWith (<>) lhs rhs
+  {-# INLINE (<>) #-}
+
+instance (Semigroup val, Ord key) => Monoid (MergeMap key val) where
+  mempty = MergeMap mempty
+  {-# INLINE mempty #-}
+
+mergeSingleton :: k -> v -> MergeMap k v
+mergeSingleton k v = MergeMap (Map.singleton k v)
diff --git a/lib/Jordan/Types/JSONError.hs b/lib/Jordan/Types/JSONError.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/Types/JSONError.hs
@@ -0,0 +1,107 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Jordan.Types.JSONError where
+
+import Control.DeepSeq
+import Data.Coerce
+import Data.Foldable
+import Data.Functor.Contravariant
+import qualified Data.List.NonEmpty as NE
+import qualified Data.Map.Strict as Map
+import qualified Data.Set as Set
+import Data.Text (Text, pack)
+import qualified Data.Text.Lazy.Builder as LB
+import GHC.Exts (IsList (..))
+import GHC.Generics
+import Jordan.FromJSON.Class
+import Jordan.ToJSON.Class
+import Jordan.Types.Internal.MergeMap
+import Jordan.Types.JSONType
+
+data JSONError
+  = -- | Generic, user-provided error message
+    ErrorMesage Text
+  | -- | JSON was not up to spec
+    ErrorInvalidJSON
+  | -- | Bad type encountered (Expected, Actual)
+    ErrorBadType {expectedType :: !JSONType, actualType :: !JSONType}
+  | -- | There was no value for this JSON
+    ErrorNoValue
+  | -- | Text constant was wrong.
+    ErrorBadTextConstant {expectedText :: !Text, actualText :: !Text}
+  | -- | An object had some bad values.
+    ErrorBadObject JSONObjectError
+  | -- | An array had some bad indices
+    ErrorBadArray JSONArrayError
+  | -- | One of multiple possible errors.
+    ErrorChoice !(Set.Set JSONError)
+  deriving (Show, Eq, Read, Ord, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+instance Semigroup JSONError where
+  (<>) ErrorNoValue ErrorNoValue = ErrorNoValue
+  (<>) ErrorNoValue !a = a
+  (<>) !a ErrorNoValue = a
+  (<>) (ErrorChoice lhs) (ErrorChoice rhs) = ErrorChoice $ lhs <> rhs
+  (<>) (ErrorChoice a) !rhs = ErrorChoice $ a <> Set.singleton rhs
+  (<>) !a (ErrorChoice rhs) = ErrorChoice (Set.singleton a <> rhs)
+  (<>) !lhs !rhs = ErrorChoice (Set.singleton lhs <> Set.singleton rhs)
+
+instance NFData JSONError
+
+-- | 'mempty' is 'ErrorNoValue'
+instance Monoid JSONError where
+  mempty = ErrorNoValue
+
+newtype JSONObjectError = MkJSONObjectError (Map.Map Text JSONError)
+  deriving (Eq, Ord, Generic)
+  deriving (NFData, IsList, Show, Read) via (Map.Map Text JSONError)
+  deriving (Semigroup, Monoid) via (MergeMap Text JSONError)
+
+instance FromJSON JSONObjectError where
+  fromJSON = MkJSONObjectError <$> fromJSON
+
+instance ToJSON JSONObjectError where
+  toJSON = contramap (Map.toAscList . keyValueErrors) $ serializeDictionary toJSON
+
+singleObjectError :: Text -> JSONError -> JSONObjectError
+singleObjectError t = MkJSONObjectError . Map.singleton t
+
+keyValueErrors :: JSONObjectError -> Map.Map Text JSONError
+keyValueErrors = coerce
+
+newtype JSONArrayError = MkJSONArrayError (Map.Map Integer JSONError)
+  deriving (Eq, Ord, Generic)
+  deriving (NFData, IsList, Show, Read) via (Map.Map Integer JSONError)
+  deriving (Semigroup, Monoid) via (MergeMap Integer JSONError)
+
+indexErrors :: JSONArrayError -> Map.Map Integer JSONError
+indexErrors = coerce
+
+instance FromJSON JSONArrayError where
+  fromJSON = MkJSONArrayError <$> fromJSON
+
+instance ToJSON JSONArrayError where
+  toJSON = contramap indexErrors toJSON
+
+prettyPrintJSONError :: JSONError -> Text
+prettyPrintJSONError = go id
+  where
+    go :: (Text -> Text) -> JSONError -> Text
+    go mapper = \case
+      ErrorMesage txt -> mapper txt
+      ErrorInvalidJSON -> mapper "Invalid JSON"
+      ErrorBadType jt jt' -> mapper "Bad type: Expected " <> pack (show jt) <> " got " <> pack (show jt')
+      ErrorNoValue -> mapper "Expected to receive a value, but did not"
+      ErrorBadTextConstant txt txt' -> mapper "Bad text constant: Expected \"" <> txt <> "\", got \"" <> txt' <> "\""
+      ErrorBadObject (MkJSONObjectError map) -> Map.foldlWithKey (\acc key value -> acc <> "\n" <> mapper key <> ":\n" <> go (mapper . ("  " <>)) value) mempty map
+      ErrorBadArray (MkJSONArrayError map) -> Map.foldlWithKey (\acc key value -> acc <> "\n" <> mapper (pack $ show key) <> ":\n" <> go (mapper . ("  " <>)) value) mempty map
+      ErrorChoice ne -> mapper "One of:\n" <> foldl' (\acc err -> acc <> go newMap err) mempty ne
+        where
+          newMap = mapper . ("  " <>)
diff --git a/lib/Jordan/Types/JSONType.hs b/lib/Jordan/Types/JSONType.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/Types/JSONType.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE DeriveGeneric #-}
+
+module Jordan.Types.JSONType where
+
+import Control.DeepSeq
+import GHC.Generics
+import Jordan.FromJSON.Class (FromJSON)
+import Jordan.ToJSON.Class (ToJSON)
+
+data JSONType
+  = JSONTypeNull
+  | JSONTypeBool
+  | JSONTypeText
+  | JSONTypeNumber
+  | JSONTypeArray
+  | JSONTypeObject
+  deriving (Show, Eq, Read, Ord, Bounded, Enum, Generic)
+
+instance ToJSON JSONType
+
+instance FromJSON JSONType
+
+instance NFData JSONType
diff --git a/lib/Jordan/Types/JSONValue.hs b/lib/Jordan/Types/JSONValue.hs
new file mode 100644
--- /dev/null
+++ b/lib/Jordan/Types/JSONValue.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+module Jordan.Types.JSONValue
+    ( JSONValue (..)
+    ) where
+
+import Data.Functor (($>))
+import Data.Functor.Contravariant (Contravariant(..))
+import qualified Data.Map.Strict as Map
+import Data.Scientific (Scientific)
+import Data.Text (Text)
+import GHC.Generics (Generic(..))
+import Jordan.FromJSON.Class (FromJSON(..), JSONParser(..))
+import Jordan.ToJSON.Class (JSONSerializer(..), Selectable(..), ToJSON(..), selected)
+
+-- | A type for any JSON value.
+-- This is a basic Haskell sum type representation.
+--
+-- This is intended to for use when working with JSON where you do not know much about its structure.
+data JSONValue
+  = JNull
+  | JBool Bool
+  | JText Text
+  | JNumber Scientific
+  | JArray [JSONValue]
+  | JObject (Map.Map Text JSONValue)
+  deriving (Show, Eq, Ord, Generic)
+
+instance FromJSON JSONValue where
+  fromJSON
+    = (parseNull $> JNull)
+    <> (JText <$> parseText)
+    <> (JBool <$> parseBool)
+    <> (JNumber <$> parseNumber)
+    <> nameParser "Jordan.JSONValue.Array.Input" (JArray <$> parseArrayWith fromJSON)
+    <> nameParser "Jordan.JSONValue.Map.Input" (JObject . Map.fromList <$> parseDictionary fromJSON)
+
+type AsEither
+  = Either ()
+      (Either Bool
+        (Either Text
+          (Either Scientific
+            (Either [JSONValue] (Map.Map Text JSONValue)))))
+
+toNestedEither
+  :: JSONValue
+  -> AsEither
+toNestedEither = \case
+  JNull -> Left ()
+  JBool b -> Right (Left b)
+  JText txt -> Right (Right (Left txt))
+  JNumber sci -> Right (Right (Right (Left sci)))
+  JArray jvs -> Right (Right (Right (Right (Left jvs))))
+  JObject map -> Right (Right (Right (Right (Right map))))
+
+instance ToJSON JSONValue where
+  toJSON = select toNestedEither serializeNull s1
+    where
+      s1 = selected serializeBool s2
+      s2 = selected serializeText s3
+      s3 = selected serializeNumber s4
+      s4
+        = selected (nameSerializer "Jordan.JSONValue.Array.Output" serializeArray)
+        $ nameSerializer "Jordan.JSONValue.Map.Output"
+        $ contramap Map.toList
+        $ serializeDictionary toJSON
diff --git a/test/Jordan/FromJSON/MegaparsecSpec.hs b/test/Jordan/FromJSON/MegaparsecSpec.hs
deleted file mode 100644
--- a/test/Jordan/FromJSON/MegaparsecSpec.hs
+++ /dev/null
@@ -1,59 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeApplications #-}
-module Jordan.FromJSON.MegaparsecSpec
-    ( spec
-    ) where
-
-import Data.Text (Text)
-import Jordan.FromJSON.Class
-import Jordan.FromJSON.Megaparsec
-import Jordan.SpecDefs
-import Test.Hspec (Spec, describe, it)
-import Test.Hspec.Megaparsec
-import Text.Megaparsec (parse)
-
-parse' a = parse a ""
-
-parseJ :: (FromJSON a) => Text -> Either ParseError a
-parseJ = parse' megaparsecParser
-
-spec :: Spec
-spec = describe "megaparsec parsing" $ do
-  commaSpec
-  anyFieldSpec
-  jsonTextSpec
-  basicParsingSpec (\t v -> parseJ t `shouldParse` v)
-  specialCaseSpec
-
-commaSpec :: Spec
-commaSpec = describe "comma parser" $ do
-  it "parses just a comma" $
-    parse' comma `shouldSucceedOn` ","
-  it "parses a comma with some extra whitespace" $
-    parse' comma `shouldSucceedOn` ",    \n\n"
-
-anyFieldSpec :: Spec
-anyFieldSpec = describe "parseAnyField" $ do
-  it "parses a very basic null field" $
-    parse' parseAnyField `shouldSucceedOn` "\"foo\": null"
-  it "parses an overly whitespaced field" $
-    parse' parseAnyField `shouldSucceedOn` "\"foo\"  : \n\n\n null"
-
-jsonTextSpec :: Spec
-jsonTextSpec = describe "parseJSONText" $ do
-  let parseText = parse' parseJSONText
-  it "parses a super basic string" $ do
-    parseText `shouldSucceedOn` "\"foo\""
-  it "parses with an escaped backslash" $ do
-    parseText "\"foo\\\\\"" `shouldParse` "foo\\"
-  it "parses with an escaped quote" $ do
-    parseText "\"foo\\\"\"" `shouldParse` "foo\""
-  it "parses with unicode" $ do
-    parseText "\"foo\\u2795\"" `shouldParse` "foo➕"
-  it "parses with trailing whitespace" $ do
-    parseText "\"foo\"  " `shouldParse` "foo"
-
-specialCaseSpec :: Spec
-specialCaseSpec = describe "special cases" $ do
-  it "does not allow mismatched labels" $
-    parse (megaparsecParser @GenericSum) "" `shouldFailOn` mismatchType
diff --git a/test/Jordan/FromJSON/UnboxedReportingSpec.hs b/test/Jordan/FromJSON/UnboxedReportingSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Jordan/FromJSON/UnboxedReportingSpec.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Jordan.FromJSON.UnboxedReportingSpec
+  ( spec,
+    prettyWhenError,
+  )
+where
+
+import Data.Text (Text)
+import Data.Text.Encoding (encodeUtf8)
+import Jordan
+import Jordan.FromJSON.Class (FromJSON (fromJSON))
+import Jordan.SpecDefs (basicParsingSpec)
+import Jordan.Types.JSONError
+import Test.Hspec (Spec, describe, it, shouldBe)
+
+prettyWhenError :: Either JSONError a -> Either Text a
+prettyWhenError = \case
+  Left je -> Left $ prettyPrintJSONError je
+  Right a -> Right a
+
+spec :: Spec
+spec = describe "Jordan.FromJSON.Reporting" $ do
+  basicParsingSpec $ \t v ->
+    prettyWhenError (parseOrReport (encodeUtf8 t)) `shouldBe` Right v
diff --git a/test/Jordan/RoundTripSpec.hs b/test/Jordan/RoundTripSpec.hs
--- a/test/Jordan/RoundTripSpec.hs
+++ b/test/Jordan/RoundTripSpec.hs
@@ -1,56 +1,80 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
-module Jordan.RoundTripSpec
-    where
 
-import Data.ByteString.Lazy (fromStrict, toStrict)
-import Data.Functor.Contravariant (Contravariant(..))
-import Data.Proxy (Proxy(..))
+module Jordan.RoundTripSpec where
+
+import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
+import qualified Data.ByteString.Lazy as LBS
+import Data.Functor.Contravariant (Contravariant (..))
 import Data.Text (Text, unpack)
+import qualified Data.Text as Text
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
+import Data.Typeable (Proxy (..), Typeable)
 import GHC.Generics
-import Jordan (parseViaAttoparsec, parseViaMegaparsec, toJSONText, toJSONViaBuilder)
-import Jordan.FromJSON.Class (FromJSON(..), JSONParser(..))
-import Jordan.ToJSON.Class (JSONSerializer(..), ToJSON(..))
+import Jordan (parseViaAttoparsec, toJSONViaBuilder)
+import Jordan.FromJSON.Class (FromJSON (..), GFromJSON (..), JSONParser (..))
+import Jordan.FromJSON.UnboxedReporting (parseOrReport)
+import Jordan.Generic.Options
+import Jordan.ToJSON.Class (GToJSON (..), JSONSerializer (..), ToJSON (..))
 import Test.Hspec (Spec, describe)
 import Test.Hspec.QuickCheck (prop)
 import Test.QuickCheck
 import Test.QuickCheck.Utf8
 
-makeResult
-  :: (ToJSON a, FromJSON a, Arbitrary a, Show a, Eq a)
-  => Proxy a
-  -> (a -> b)
-  -> (b -> String)
-  -> (b -> Either String a)
-  -> Property
+data PropertyResult exp = MkPropertyResult
+  { expectedValue :: exp,
+    actualValue :: Either String exp,
+    jsonStringTested :: Text
+  }
+  deriving (Show, Read)
+
+roundtripProperty ::
+  (ToJSON a, FromJSON a, Arbitrary a, Show a, Eq a, Eq err, Show err) =>
+  Proxy a ->
+  (ByteString -> Either err a) ->
+  (err -> String) ->
+  Property
+roundtripProperty (Proxy :: Proxy a) parser mapErr =
+  forAllShrink (arbitrary @a) (shrink @a) $ \a ->
+    let built = toJSONViaBuilder a
+     in counterexample (show built) $ parser (toJSONViaBuilder a) === Right a
+
+makeResult ::
+  (ToJSON a, FromJSON a, Arbitrary a, Show a, Eq a) =>
+  Proxy a ->
+  (a -> b) ->
+  (b -> String) ->
+  (b -> Either String a) ->
+  Property
 makeResult (Proxy :: Proxy a) convForward convString convBack =
   forAllShow (arbitrary @a) showResult convert
-      where
-        showResult a
-          = show a
-          <> "\n"
-          <> convString (convForward  a)
-          <> "\n"
-          <> showError (convBack $ convForward a)
-        convert a = convBack (convForward a) == pure a
-        showError :: Either String a -> String
-        showError (Left err) = "Error\n" <> err
-        showError (Right a) = "Success: " <> show a
+  where
+    showResult a =
+      show a
+        <> "\n"
+        <> convString (convForward a)
+        <> "\n"
+        <> showError (convBack $ convForward a)
+    convert a = convBack (convForward a) == pure a
+    showError :: Either String a -> String
+    showError (Left err) = "Error\n" <> err
+    showError (Right a) = "Success: " <> show a
 
-newtype ExtremelyBasic
-  = ExtremelyBasic { getExtremelyBasic :: () }
+newtype ExtremelyBasic = ExtremelyBasic {getExtremelyBasic :: ()}
   deriving (Eq, Show, Generic)
   deriving anyclass (ToJSON, FromJSON)
 
 instance Arbitrary ExtremelyBasic where
   arbitrary = ExtremelyBasic <$> arbitrary
 
-data TwoFieldsRec
-  = TwoFieldsRec { firstField :: Int, secondField :: Int }
+data TwoFieldsRec = TwoFieldsRec {firstField :: Int, secondField :: Int}
   deriving (Eq, Show, Generic)
   deriving anyclass (ToJSON, FromJSON)
 
@@ -69,37 +93,43 @@
 instance Arbitrary RLMSum where
   arbitrary = arbitraryBoundedEnum
 
-data ManyChoices
-  = ChoseFirst { getFirst :: Int }
-  | ChoseSecond { getSecondA :: Int, getSecondB :: Int }
+data TwoChoices
+  = ChoseFirst {getFirst :: Int}
+  | ChoseSecond {getSecondA :: Int, getSecondB :: Int}
   deriving (Eq, Show, Generic)
   deriving anyclass (ToJSON, FromJSON)
 
-instance Arbitrary ManyChoices where
-  arbitrary
-    = oneof
-    [ ChoseFirst <$> arbitrary
-    , ChoseSecond <$> arbitrary <*> arbitrary
-    ]
+instance Arbitrary TwoChoices where
+  arbitrary =
+    oneof
+      [ ChoseFirst <$> arbitrary,
+        ChoseSecond <$> arbitrary <*> arbitrary
+      ]
 
-data FakePerson
-  = FakePerson
-  { age :: Int
-  , name :: String
-  , cool :: Bool
-  } deriving (Eq, Show, Generic)
+data FakePerson = FakePerson
+  { age :: Int,
+    name :: String,
+    cool :: Bool
+  }
+  deriving (Eq, Show, Generic)
   deriving anyclass (FromJSON, ToJSON)
 
 instance Arbitrary FakePerson where
-  arbitrary
-    = FakePerson
-    <$> arbitrary
-    <*> fmap unpack genValidUtf8
-    <*> arbitrary
+  arbitrary =
+    FakePerson
+      <$> arbitrary
+      <*> fmap unpack genValidUtf8
+      <*> arbitrary
 
-newtype OnlyText = OnlyText { getText :: Text }
-  deriving (Show, Eq)
+newtype OnlyText = OnlyText {getText :: Text}
+  deriving (Show, Eq, Generic)
 
+shrinkText :: Text -> [Text]
+shrinkText t
+  | Text.length t == 0 = []
+  | Text.length t == 1 = [""]
+  | otherwise = Text.singleton <$> Text.unpack t
+
 instance ToJSON OnlyText where
   toJSON = contramap getText serializeText
 
@@ -108,70 +138,139 @@
 
 instance Arbitrary OnlyText where
   arbitrary = OnlyText <$> genValidUtf8
+  shrink (OnlyText t) = OnlyText <$> shrinkText t
 
 data EnumyObject
   = EnumA
   | EnumB
   | EnumC
-  | EnumObject { enumValue :: Text }
+  | EnumObject {enumValue :: Text}
+  | EnumOther OnlyText
   deriving (Show, Eq, Generic)
   deriving anyclass (ToJSON, FromJSON)
 
 instance Arbitrary EnumyObject where
-  arbitrary
-    = oneof
-    [ pure EnumA
-    , pure EnumB
-    , pure EnumC
-    , EnumObject <$> genValidUtf8
-    ]
+  arbitrary =
+    oneof
+      [ pure EnumA,
+        pure EnumB,
+        pure EnumC,
+        EnumObject <$> genValidUtf8,
+        EnumOther <$> arbitrary
+      ]
+  shrink (EnumObject o) = EnumObject <$> shrinkText o
+  shrink (EnumOther ot) = EnumOther <$> shrink ot
+  shrink _ = []
 
-data AllTogether
-  = AllTogether
-  { extremelyBasic :: ExtremelyBasic
-  , twoFieldsRec :: TwoFieldsRec
-  , rlmSum :: RLMSum
-  , fakePerson :: FakePerson
-  , onlyText :: OnlyText
-  , enumyObject :: EnumyObject
-  } deriving (Eq, Show, Generic)
+data AllTogether = AllTogether
+  { extremelyBasic :: ExtremelyBasic,
+    twoFieldsRec :: TwoFieldsRec,
+    rlmSum :: RLMSum,
+    fakePerson :: FakePerson,
+    onlyText :: OnlyText,
+    enumyObject :: EnumyObject
+  }
+  deriving (Eq, Show, Generic)
   deriving anyclass (ToJSON, FromJSON)
 
 instance Arbitrary AllTogether where
-  arbitrary
-    = AllTogether
-    <$> arbitrary
-    <*> arbitrary
-    <*> arbitrary
-    <*> arbitrary
-    <*> arbitrary
-    <*> arbitrary
+  arbitrary =
+    AllTogether
+      <$> arbitrary
+      <*> arbitrary
+      <*> arbitrary
+      <*> arbitrary
+      <*> arbitrary
+      <*> arbitrary
+  shrink (AllTogether ub tfr rs fp ot eo) =
+    AllTogether
+      <$> shrink ub
+      <*> shrink tfr
+      <*> shrink rs
+      <*> shrink fp
+      <*> shrink ot
+      <*> shrink eo
 
+data AnnoyinglyOptional = AnnoyinglyOptional
+  { annoyingFirst :: Maybe Int,
+    annoyingSecond :: Maybe Int,
+    annoyingThird :: Maybe Int
+  }
+  deriving (Show, Read, Eq, Ord, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+instance Arbitrary AnnoyinglyOptional where
+  arbitrary =
+    pure $ AnnoyinglyOptional Nothing Nothing Nothing
+
+-- <$> arbitrary <*> arbitrary <*> arbitrary
+
+data JustNulls = JustNulls
+  { jna :: (),
+    jnb :: (),
+    jnc :: (),
+    jnd :: (),
+    jne :: (),
+    jnf :: ()
+  }
+  deriving (Show, Read, Eq, Ord, Generic)
+  deriving anyclass (ToJSON, FromJSON)
+
+instance Arbitrary JustNulls where
+  arbitrary =
+    pure $
+      JustNulls () () () () () ()
+
 showViaText :: (ToJSON a) => a -> String
-showViaText = unpack . toJSONText
+showViaText = unpack . decodeUtf8 . LBS.toStrict . toJSONViaBuilder
 
 showViaBuilder :: (ToJSON a) => a -> String
 showViaBuilder = unpack . decodeUtf8 . toStrict . toJSONViaBuilder
 
-roundtrips
-  :: (Arbitrary a, Show a, Eq a, ToJSON a, FromJSON a)
-  => String
-  -> Proxy a
-  -> Spec
-roundtrips n p = describe ("round-trippping " <> n) $ do
-  describe "when serializing via text" $ do
-    let q = makeResult p toJSONText unpack
-    prop "roundtrips back via megaparsec" $
-      q parseViaMegaparsec
-    prop "roundtrips back via attoparsec" $
-      q (parseViaAttoparsec . encodeUtf8)
+showLeft :: (Show a) => Either a b -> Either [Char] b
+showLeft = \case
+  Left a -> Left (show a)
+  Right b -> Right b
+
+instance Arbitrary a => Arbitrary (WithOptions opts a) where
+  arbitrary = WithOptions <$> arbitrary
+  shrink (WithOptions a) = WithOptions <$> shrink a
+
+roundtrips' ::
+  (Arbitrary a, Show a, Eq a, ToJSON a, FromJSON a) =>
+  Proxy a ->
+  Spec
+roundtrips' p = do
   describe "when serializing via a builder" $ do
-    let q = makeResult p toJSONViaBuilder (unpack . decodeUtf8 . toStrict)
-    prop "roundtrips back via megaparsec" $
-      q (parseViaMegaparsec . decodeUtf8 . toStrict)
     prop "roundtrips back via attoparsec" $
-      q (parseViaAttoparsec . toStrict)
+      roundtripProperty p (parseViaAttoparsec . toStrict) show
+    prop "roundstrips back via unboxed reporting" $
+      roundtripProperty p (parseOrReport . toStrict) show
 
+roundtrips ::
+  ( Arbitrary a,
+    Typeable a,
+    Show a,
+    Eq a,
+    ToJSON a,
+    FromJSON a,
+    Generic a,
+    GToJSON (Rep a),
+    GFromJSON (Rep a)
+  ) =>
+  String ->
+  Proxy a ->
+  Spec
+roundtrips n p@(Proxy :: Proxy a) = describe ("round-tripping " <> n) $ do
+  describe "default roundtrips" $
+    roundtrips' p
+  describe "roundtrips with no options" $
+    roundtrips' (Proxy @(WithOptions '[] a))
+  describe "Roundtrips omitting nothing fields" $
+    roundtrips' (Proxy @(WithOptions '[OmitNothingFields] a))
+  describe "Roundtrips keeping nothing fields" $
+    roundtrips' (Proxy @(WithOptions '[KeepNothingFields] a))
+
 spec :: Spec
 spec = describe "round-tripping generic values" $ do
   roundtrips "a newtype around ()" (Proxy @ExtremelyBasic)
@@ -181,3 +280,5 @@
   roundtrips "just text" (Proxy @OnlyText)
   roundtrips "an object with some constructors as enums" (Proxy @EnumyObject)
   roundtrips "an object composed of all rountrip'd objects" (Proxy @AllTogether)
+  roundtrips "an object with optional fields" (Proxy @AnnoyinglyOptional)
+  roundtrips "an object that is jut a bunch of nulls" (Proxy @JustNulls)
diff --git a/test/Jordan/SpecDefs.hs b/test/Jordan/SpecDefs.hs
--- a/test/Jordan/SpecDefs.hs
+++ b/test/Jordan/SpecDefs.hs
@@ -1,23 +1,27 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
-module Jordan.SpecDefs
-    where
 
-import Control.Applicative (Alternative((<|>)))
+module Jordan.SpecDefs where
+
+import Control.Applicative (Alternative ((<|>)))
+import Data.Foldable
 import Data.Functor.Contravariant
 import Data.Functor.Contravariant.Divisible
-import Data.String (IsString(..))
+import Data.Scientific (Scientific, scientific)
+import Data.String (IsString (..))
 import Data.Text (Text, pack)
 import GHC.Generics (Generic)
 import Jordan.FromJSON.Class
+import Jordan.Generic.Options
 import Jordan.ToJSON.Class
-import Test.Hspec (Arg, Example, Spec, SpecWith, describe, it, shouldBe)
+import Test.Hspec (Arg, Example, Spec, SpecWith, describe, fit, it, shouldBe)
 import Text.RawString.QQ
 
-newtype BasicStruct
-  = BasicStruct { bar :: () }
+newtype BasicStruct = BasicStruct {bar :: ()}
   deriving (Show, Eq, Ord)
 
 goodBasic :: BasicStruct
@@ -26,48 +30,62 @@
 instance FromJSON BasicStruct where
   fromJSON = (BasicStruct <$> fromNull) <> fromObject
     where
-      fromObject = parseObject "TestItems.BasicStruct.Output" $
-        BasicStruct <$> parseField "bar"
+      fromObject =
+        parseObject $
+          BasicStruct <$> parseField "bar"
       fromNull = parseNull
 
 instance ToJSON BasicStruct where
-  toJSON = serializeObject "TestItems.BasicStruct.Input" $ writeField "bar" serializeNull
+  toJSON = serializeObject $ serializeFieldWith "bar" serializeNull
 
 basicNull = pack [r| null |]
+
+basicOneFieldNoSpace = pack [r|{"bar":null}|]
+
 basicOneField = pack [r| { "bar": null } |]
-basicEscaped = pack [r| { "\u0062\u0061\u0072": null } |]
+
+basicEscaped = pack [r| { "\u0062\u0061\u0072": null }|]
+
+basicEscapedNoSpace = pack [r|{"\u0062\u0061\u0072":null}|]
+
 basicPartialEscape = pack [r| { "\u0062a\u0072": null } |]
 
 basicExtraFields = pack [r| { "whatever": null, "bar": null, "baz": null } |]
 
 basicArray = pack [r| [null, { "whatever": null, "bar": null }, null, null] |]
 
-data TwoFields
-  = TwoFields { one :: (), two :: () }
+data TwoFields = TwoFields {one :: (), two :: ()}
   deriving (Show, Eq, Ord, Generic)
 
 goodTwo :: TwoFields
 goodTwo = TwoFields () ()
 
 instance FromJSON TwoFields where
-  fromJSON = parseObject "TwoFields" $ TwoFields <$> parseField "one" <*> parseField "two"
+  fromJSON = parseObject $ TwoFields <$> parseField "one" <*> parseField "two"
 
-twoSimple = pack [r| { "one": null, "two": null } |]
+twoSimple = pack [r| { "one"   :   null, "two": null } |]
 
-twoScramble = pack [r| { "two": null, "one": null } |]
+twoScramble = pack [r| {"two":null,"one":null} |]
 
-twoExtra = pack [r|
+twoExtra =
+  pack
+    [r|
   {
     "ignore": [],
     "one": null,
-    "bad": {},
-    "another": [1,2,3],
-    "yetAgain": null,
+    "four": [],
+    "five": "test",
+    "seven": {},
+    "six": "why tho",
     "two": null,
-    "three": null }
+    "three": {},
+    "ignored": [1,2,3,4, { " foo " : null }]
+  }
 |]
 
-twoScrambleExtra = pack [r|
+twoScrambleExtra =
+  pack
+    [r|
   {
     "ignore": null,
     "bad": null,
@@ -78,11 +96,11 @@
   }
 |]
 
-data GenericStruct
-  = GenericStruct
-  { firstLabel :: ()
-  , secondLabel :: [()]
-  } deriving (Show, Read, Eq, Ord, Generic)
+data GenericStruct = GenericStruct
+  { firstLabel :: (),
+    secondLabel :: [()]
+  }
+  deriving (Show, Read, Eq, Ord, Generic)
 
 instance FromJSON GenericStruct
 
@@ -96,14 +114,57 @@
 instance FromJSON GenericSum
 
 sumBasic = pack [r| { "GenericBasic": null } |]
+
 sumBasicObj = pack [r| { "GenericBasic": { "bar": null } } |]
 
 sumTwo = pack [r| { "GenericTwo": { "one": null, "two": null, "bar": null } } |]
+
 mismatchType = pack [r| { "GenericTwo": null } |]
 
-basicWritingSpec
-  :: (forall val. (ToJSON val, Show val) => val -> Text)
-  -> Spec
+data Coord = Coord {x :: !Double, y :: !Double}
+  deriving (Show, Eq, Ord, Generic)
+
+instance FromJSON Coord where
+  fromJSON = fromObject <> fromArray
+    where
+      fromObject = parseObject $ Coord <$> parseField "x" <*> parseField "y"
+      fromArray = parseTuple $ Coord <$> consumeItem <*> consumeItem
+
+coordBasic = pack [r|{ "x": 10, "y": 10 } |]
+
+coordReverse = pack [r| { "y": 11, "x": 12 } |]
+
+coordExtra = pack [r| { "x": 1, "y": 2, "z": 3 } |]
+
+coordNoSpaceDecimal = pack [r|{"x":0.0,"y":0.0}|]
+
+coordTuple = pack [r| [1, 20] |]
+
+data HomogenousCoord = HomogenousCoord {hx :: !Double, hy :: !Double, hz :: !Double}
+  deriving (Show, Read, Eq, Ord, Generic)
+
+instance FromJSON HomogenousCoord where
+  fromJSON = fromObject <> fromObjectZero <> fromArray <> fromArrayZero
+    where
+      fromObject = parseObject $ mk <$> parseField "x" <*> parseField "y" <*> parseField "z"
+      fromObjectZero = parseObject $ mk <$> parseField "x" <*> parseField "y" <*> pure 1.0
+      fromArray = parseTuple $ mk <$> consumeItem <*> consumeItem <*> consumeItem
+      fromArrayZero = parseTuple $ mk <$> consumeItem <*> consumeItem <*> pure 1.0
+      mk = HomogenousCoord
+
+data WeirdFeedback
+  = GeneralFeedback Text
+  | SpecificFeedback [(Text, Text)]
+  deriving (Show, Eq)
+
+instance FromJSON WeirdFeedback where
+  fromJSON =
+    parseObject (GeneralFeedback <$> parseField "general")
+      <> (SpecificFeedback <$> parseDictionary fromJSON)
+
+basicWritingSpec ::
+  (forall val. (ToJSON val, Show val) => val -> Text) ->
+  Spec
 basicWritingSpec writeJSON = do
   describe "writing basic primitives" $ do
     it "writes nulls" $
@@ -117,7 +178,7 @@
     it "writes an array with one item" $ do
       writeJSON [()] `shouldBe` "[null]"
     it "writes an array with two items" $ do
-      writeJSON [(),()] `shouldBe` "[null,null]"
+      writeJSON [(), ()] `shouldBe` "[null,null]"
     it "writes the number 1" $ do
       writeJSON (1 :: Int) `shouldBe` "1.0"
     it "writes the number 1.5" $ do
@@ -134,63 +195,70 @@
     it "writes properly" $ do
       writeJSON goodBasic `shouldBe` [r|{"bar": null}|]
 
-basicParsingSpec
-  :: (Example a)
-  => (forall val. (FromJSON val, Show val, Eq val) => Text -> val -> a)
-  -> SpecWith (Arg a)
+basicParsingSpec ::
+  (Example a) =>
+  (forall val. (FromJSON val, Show val, Eq val) => Text -> val -> a) ->
+  SpecWith (Arg a)
 basicParsingSpec parseMatch = do
+  let parseExample t v = it ("parses " <> show t <> " to " <> show v) $ t `parseMatch` v
+
   describe "parsing basic structure" $ do
-    it "parses true" $
-      "true" `parseMatch` True
-    it "parses false" $
-      "false" `parseMatch` False
-    it "parses a raw null" $
-      "null" `parseMatch` ()
-    it "parses an empty array of nulls" $
-      "[]" `parseMatch` ([] :: [()])
-    it "parses a one-null array" $ do
-      "[null ]" `parseMatch` [()]
-    it "parses a two-null array with weird spaces" $ do
-      "[null\n,null]" `parseMatch` [(), ()]
-    it "parses null to a basic struct" $
-      basicNull `parseMatch` goodBasic
-    it "parses with field" $
-      basicOneField `parseMatch` goodBasic
-    it "parses with two fields" $
-      basicExtraFields `parseMatch` goodBasic
-    it "parses with a fully-escaped field" $
-      basicEscaped `parseMatch` goodBasic
-    it "parses with a partially-escaped field" $
-      basicPartialEscape `parseMatch` goodBasic
-    it "parses an array" $
-      basicArray `parseMatch` replicate 4 goodBasic
+    parseExample "true" True
+    parseExample "false" False
+    parseExample "null" ()
+  describe "parsing numbers" $ do
+    let m (t, e, i) = parseExample t $ scientific e i
+    traverse_
+      m
+      [ ("0", 0, 0),
+        ("1", 1, 0),
+        ("20", 20, 0),
+        ("190865", 190865, 0),
+        ("-0", 0, 0),
+        ("-1", -1, 0),
+        ("-10.5", -105, -1),
+        ("-1e100", -1, 100)
+      ]
+  describe "basic array parsing" $ do
+    "[]" `parseExample` ([] :: [()])
+    "[null ]" `parseExample` [()]
+    "[null\n,null]" `parseExample` [(), ()]
+    basicNull `parseExample` goodBasic
+    basicArray `parseExample` replicate 4 goodBasic
+  describe "basic object parsing" $ do
+    basicOneFieldNoSpace `parseExample` goodBasic
+    basicOneField `parseExample` goodBasic
+    basicExtraFields `parseExample` goodBasic
+    basicEscaped `parseExample` goodBasic
+    basicEscapedNoSpace `parseExample` goodBasic
+    basicPartialEscape `parseExample` goodBasic
+  describe "parsing coordinates" $ do
+    coordBasic `parseExample` Coord 10 10
+    coordReverse `parseExample` Coord 12 11
+    coordExtra `parseExample` Coord 1 2
+    coordTuple `parseExample` Coord 1 20
+    coordNoSpaceDecimal `parseExample` Coord 0 0
+  describe "parsing homogenous coords" $ do
+    "[1,2]" `parseExample` HomogenousCoord 1 2 1
+    "[1,2,2]" `parseExample` HomogenousCoord 1 2 2
+    "{ \"x\": 1, \"y\": 2, \"z\": 10 }" `parseExample` HomogenousCoord 1 2 10
   describe "string parsing" $ do
-    it "parses with an escaped backslash" $ do
-      "\"foo\\\\\"" `parseMatch` ("foo\\" :: Text)
-    it "parses with an escaped quote" $ do
-      "\"foo\\\"\"" `parseMatch` ("foo\"" :: Text)
-    it "parses with unicode" $ do
-      "\"foo\\u2795\"" `parseMatch` ("foo➕" :: Text)
-    it "parses a text with no escapes" $ do
-      [r|"foo"|] `parseMatch` ("foo" :: Text)
-    it "parses a text with an escaped backslash" $ do
-      [r|"foo\\\\"|] `parseMatch` ([r|foo\\|] :: Text)
+    "\"foo\\\\\"" `parseExample` ("foo\\" :: Text)
+    "\"foo\\\"\"" `parseExample` ("foo\"" :: Text)
+    "\"foo\\u2795\"" `parseExample` ("foo➕" :: Text)
+    [r|"foo"|] `parseExample` ("foo" :: Text)
+    [r|"foo\\\\"|] `parseExample` ([r|foo\\|] :: Text)
   describe "parsing a two-field object" $ do
-    it "parses with only required fields" $
-      twoSimple `parseMatch` goodTwo
-    it "parses with only required fields in wrong order" $
-      twoScramble `parseMatch` goodTwo
-    it "parses with lots of extra crap" $
-      twoExtra `parseMatch` goodTwo
-    it "parses in a weird order with extra crap" $
-      twoScrambleExtra `parseMatch` goodTwo
+    twoSimple `parseExample` goodTwo
+    twoScramble `parseExample` goodTwo
+    twoExtra `parseExample` goodTwo
+    twoScrambleExtra `parseExample` goodTwo
   describe "parsing a generically-derived object" $ do
-    it "parses correctly in the basic case" $
-      genericDefault `parseMatch` GenericStruct () [()]
+    genericDefault `parseExample` GenericStruct () [()]
   describe "parsing a generally-derived sum object" $ do
-    it "parses first correctly" $
-      sumBasic `parseMatch` GenericBasic (BasicStruct ())
-    it "parses first correctrly when using other alternate" $
-      sumBasicObj `parseMatch` GenericBasic (BasicStruct ())
-    it "parses second correctly" $
-      sumTwo `parseMatch` GenericTwo (TwoFields () ())
+    sumBasic `parseExample` GenericBasic (BasicStruct ())
+    sumBasicObj `parseExample` GenericBasic (BasicStruct ())
+    sumTwo `parseExample` GenericTwo (TwoFields () ())
+  describe "object parsing with possible weirdness" $ do
+    pack [r| {"general": "it sucked", "foo": "bar"} |] `parseExample` GeneralFeedback "it sucked"
+    pack [r| {"foo": "bar"} |] `parseExample` SpecificFeedback [("foo", "bar")]
diff --git a/test/Jordan/ToJSON/TextSpec.hs b/test/Jordan/ToJSON/TextSpec.hs
deleted file mode 100644
--- a/test/Jordan/ToJSON/TextSpec.hs
+++ /dev/null
@@ -1,85 +0,0 @@
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-module Jordan.ToJSON.TextSpec
-    where
-
-import Data.Text (pack)
-import GHC.Generics
-import Jordan.SpecDefs (basicWritingSpec)
-import Jordan.ToJSON.Class
-import Jordan.ToJSON.Text
-import Test.Hspec
-import Text.RawString.QQ
-
-shouldRenderJSON
-  :: (ToJSON a, Show a, HasCallStack)
-  => a
-  -> String
-  -> Expectation
-shouldRenderJSON f a =
-  runJSONText toJSON f "" `shouldBe` pack a
-
-data UselessTuple
-  = UselessTuple
-  { first :: ()
-  , second :: ()
-  } deriving (Show, Generic)
-
-instance ToJSON UselessTuple
-
-newtype NestedTuple
-  = NestedTuple
-  { getNestedTuple :: UselessTuple }
-  deriving (Show, Generic)
-
-instance ToJSON NestedTuple
-
-newtype WrapFoo
-  = WrapFoo { getFoo :: () }
-  deriving (Show, Generic)
-
-instance ToJSON WrapFoo
-
-newtype WrapBar
-  = WrapBar { getBar :: () }
-  deriving (Show, Generic)
-
-instance ToJSON WrapBar
-
-data PickOne
-  = PickFoo WrapFoo
-  | PickBar WrapBar
-  deriving (Show, Generic)
-
-instance ToJSON PickOne
-
-spec :: Spec
-spec = describe "Jordan.ToJSON.Text" $ do
-  basicWritingSpec $ \v -> toJSONText v
-  arrayRendering
-  genericsRendering
-
-arrayRendering :: Spec
-arrayRendering = describe "array rendering" $ do
-  it "renders an empty array properly" $ do
-    ([] :: [()]) `shouldRenderJSON` "[]"
-  it "renders a one-item array properly" $ do
-    [()] `shouldRenderJSON` "[null]"
-  it "renders a two-item array properly" $ do
-    [(), ()] `shouldRenderJSON` "[null,null]"
-
-genericsRendering :: Spec
-genericsRendering = describe "generics rendering" $ do
-  it "can render a basic two-field object" $ do
-    UselessTuple () () `shouldRenderJSON` [r|{"first": null, "second": null}|]
-  it "can render a basic two-field object nested" $ do
-    NestedTuple (UselessTuple () ()) `shouldRenderJSON`
-      [r|{"getNestedTuple": {"first": null, "second": null}}|]
-  it "can render first case of PickOne" $ do
-    PickFoo (WrapFoo ()) `shouldRenderJSON`
-      [r|{"PickFoo": {"getFoo": null}}|]
-  it "can render second case of pickone" $ do
-    PickBar (WrapBar ()) `shouldRenderJSON`
-      [r|{"PickBar": {"getBar": null}}|]
diff --git a/test/JordanSpec.hs b/test/JordanSpec.hs
--- a/test/JordanSpec.hs
+++ b/test/JordanSpec.hs
@@ -1,18 +1,17 @@
 module Main
-    ( main
-    ) where
+  ( main,
+  )
+where
 
 import qualified Jordan.FromJSON.AttoparsecSpec as APS
-import qualified Jordan.FromJSON.MegaparsecSpec as MPS
+import qualified Jordan.FromJSON.UnboxedReportingSpec as UR
 import qualified Jordan.RoundTripSpec as RTS
 import qualified Jordan.ToJSON.BuilderSpec as BS
-import qualified Jordan.ToJSON.TextSpec as TS
 import Test.Hspec (hspec)
 
 main :: IO ()
 main = hspec $ do
-  MPS.spec
   APS.spec
-  TS.spec
   BS.spec
   RTS.spec
+  UR.spec