diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -1,5 +1,12 @@
 # Changelog for persistent
 
+# 2.17.1.0
+
+* [#1601](https://github.com/yesodweb/persistent/pull/1601)
+  * Fix parsing of quoted entity field attributes
+  * Add and enforce `psQuotedAttributeErrorLevel` to deprecate quoted entity field attributes
+  * Improve parsing of types and entity fields
+
 # 2.17.0.0
 
 * [#1595](https://github.com/yesodweb/persistent/pull/1595)
diff --git a/Database/Persist/Quasi.hs b/Database/Persist/Quasi.hs
--- a/Database/Persist/Quasi.hs
+++ b/Database/Persist/Quasi.hs
@@ -4,934 +4,937 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-{-|
-This module defines the Persistent entity syntax used in the quasiquoter to generate persistent entities.
-
-The basic structure of the syntax looks like this:
-
-> TableName
->     fieldName      FieldType
->     otherField     String
->     nullableField  Int       Maybe
-
-You start an entity definition with the table name, in this case, @TableName@. It's followed by a list of fields on the entity, which have the basic form @fieldName FieldType@. You can indicate that a field is nullable with 'Maybe' at the end of the type.
-
-@persistent@ automatically generates an ID column for you, if you don't specify one, so the above table definition corresponds to the following SQL:
-
-> CREATE TABLE table_name (
->     id                SERIAL PRIMARY KEY,
->     field_name        field_type NOT NULL,
->     other_field       varchar    NOT NULL,
->     nullable_field    int NULL
-> );
-
-Note that the exact SQL that is generated can be customized using the 'PersistSettings' that are passed to the 'parse' function.
-
-It generates a Haskell datatype with the following form:
-
-@
-data TableName = TableName
-    { tableNameFieldName :: FieldType
-    , tableNameOtherField :: String
-    , tableNameNullableField :: Maybe Int
-    }
-@
-
-As with the SQL generated, the specifics of this are customizable.
-See the "Database.Persist.TH" module for details.
-
-= Deriving
-
-You can add a deriving clause to a table, and the generated Haskell type will have a deriving clause with that.
-Unlike normal Haskell syntax, you don't need parentheses or commas to separate the classes, and you can even have multiple deriving clauses.
-
-> User
->     name String
->     age  Int
->     deriving Eq Show
->     deriving Ord
-
-= Unique Keys
-
-You can define a uniqueness key on a table with the following format:
-
-> User
->    name String
->    age  Int
->
->    UniqueUserName name
-
-This will put a unique index on the @user@ table and the @name@ field.
-
-= Setting defaults
-
-You can use a @default=${sql expression}@ clause to set a default for a field.
-The thing following the @=@ is interpreted as SQL that will be put directly into the table definition.
-
-@
-User
-    name    Text
-    admin   Bool default=false
-@
-
-This creates a SQL definition like this:
-
-> CREATE TABLE user (
->   id      SERIAL PRIMARY KEY,
->   name    VARCHAR NOT NULL,
->   admin   BOOL DEFAULT=false
-> );
-
-A restriction here is that you still need to provide a value when performing an @insert@, because the generated Haskell type has the form:
-
-@
-data User = User
-    { userName :: Text
-    , userAdmin :: Bool
-    }
-@
-
-You can work around this by using a 'Maybe Bool' and supplying 'Nothing' by default.
-
-__Note__: Persistent determines whether or not to migrate a column's default
-value by comparing the exact string found in your @models@ file with the one
-returned by the database. If a database canonicalizes the SQL @FALSE@ from your
-@models@ file to @false@ in the database, Persistent will think the default
-value needs to be migrated and
-<https://github.com/yesodweb/persistent/issues/241 attempt a migration each time you start your app>.
-
-To workaround this, find the exact SQL your DBMS uses for the default value. For example, using postgres:
-
-@
-psql database_name # Open postgres
-
-\\d+ table_name -- describe the table schema
-@
-
-@
-...
-created       | timestamp without time zone | not null default now()
-@
-
-Then use the listed default value SQL inside your @models@ file.
-
-= Custom ID column
-
-If you don't want to use the default ID column type of 'Int64', you can set a custom type with an @Id@ field.
-This @User@ has a @Text@ ID.
-
-> User
->     Id   Text
->     name Text
->     age  Int
-
-If you do this, it's a good idea to set a default for the ID.
-Otherwise, you will need to use 'insertKey' instead of 'insert' when performing inserts.
-
-@
-'insertKey' (UserKey "Hello world!") (User "Bob" 32)
-@
-
-If you attempt to do @'insert' (User "Bob" 32)@, then you will receive a runtime error because the SQL database doesn't know how to make an ID for you anymore.
-So instead just use a default expression, like this:
-
-@
-User
-    Id      Text default=generate_user_id()
-    name    Text
-    age     Int
-@
-
-= Custom Primary Keys
-
-Sometimes you don't want to have an ID column, and you want a different sort of primary key.
-This is a table that stores unique email addresses, and the email is the primary key.
-We store the first and second part (eg @first\@second@) separately.
-
-@
-Email
-    firstPart   Text
-    secondPart  Text
-
-    Primary firstPart secondPart
-@
-
-This creates a table with the following form:
-
-@
-CREATE TABLE email (
-    first_part  varchar,
-    second_part varchar,
-
-    PRIMARY KEY (first_part, second_part)
-@
-
-Since the primary key for this table is part of the record, it's called a "natural key" in the SQL lingo.
-As a key with multiple fields, it is also a "composite key."
-
-You can specify a @Primary@ key with a single field, too.
-
-= Overriding SQL
-
-You can use a @sql=custom@ annotation to provide some customization on the entity and field.
-For example, you might prefer to name a table differently than what @persistent@ will do by default.
-You may also prefer to name a field differently.
-
-@
-User sql=big_user_table
-    fullName    String sql=name
-    age         Int
-@
-
-This will alter the generated SQL to be:
-
-@
-CREATE TABEL big_user_table (
-    id      SERIAL PRIMARY KEY,
-    name    VARCHAR,
-    age     INT
-);
-@
-
-= Customizing Types/Tables
-
-== JSON instances
-
-You can automatically get ToJSON and FromJSON instances for any entity by adding @json@ to the entity line:
-
-@
-Person json
-    name Text
-@
-Requires @\{\-\# LANGUAGE FlexibleInstances \#\-\}@
-
-Customizable by using mpsEntityJSON
-* http://hackage.haskell.org/package/persistent-template/docs/Database-Persist-TH.html#v:EntityJSON
-* http://hackage.haskell.org/package/persistent/docs/Database-Persist-Class.html#v:keyValueEntityToJSON
-
-== Changing table/collection name
-
-@
-Person sql=peoples
-    name Text
-@
-
-== Change table/collection key definition (field name and\/or type, persistent >= 2.1)
-
-@Id@ defines the column to use to define the key of the entity.
-Without type, the default backend key type will be used. You can change its
-database name using the @sql@ attributes :
-
-@
-Person
-   Id         sql=my_id_name
-   phone Text
-@
-
-With a Haskell type, the corresponding type is used. Note that you'll need to
-use @default=@ to tell it what to do on insertion.
-
-@
-Person
-   Id    Day default=CURRENT_DATE
-   phone Text
-@
-
-@default=@ works for SQL databases, and is backend specific.
-For MongoDB currently one always needs to create the key on the application
-side and use @insertKey@. @insert@ will not work correctly. Sql backends can
-also do this if default does not work.
-
-@sqltype@ can also be used to specify a different database type
-
-@
-Currency
-    Id String sqltype=varchar(3) sql=code
-@
-
-Composite key (using multiple columns) can also be defined using @Primary@.
-
-@sql=@ also works for setting the names of unique indexes.
-
-@
-Person
-  name Text
-  phone Text
-  UniquePersonPhone phone sql=UniqPerPhone
-@
-
-This makes a unique index requiring @phone@ to be unique across @Person@ rows.
-Ordinarily Persistent will generate a snake-case index name from the
-capitalized name provided such that @UniquePersonPhone@ becomes
-@unique_person_phone@. However, we provided a @sql=@ so the index name in the
-database will instead be @UniqPerPhone@. Keep in mind @sql=@ and @!@ attrs must
-come after the list of fields in front of the index name in the quasi-quoter.
-
-
-
-= Customizing Fields
-
-== Nullable Fields
-
-As illustrated in the example at the beginning of this page, we are able to represent nullable
-fields by including 'Maybe' at the end of the type declaration:
-
-> TableName
->     fieldName      FieldType
->     otherField     String
->     nullableField  Int       Maybe
-
-Alternatively we can specify the keyword nullable:
-
-> TableName
->     fieldName      FieldType
->     otherField     String
->     nullableField  Int       nullable
-
-However the difference here is in the first instance the Haskell type will be 'Maybe Int',
-but in the second it will be 'Int'. Be aware that this will cause runtime errors if the
-database returns @NULL@ and the @PersistField@ instance does not handle @PersistNull@.
-
-If you wish to define your Maybe types in a way that is similar to the actual Haskell
-definition, you can define 'Maybe Int' like so:
-
-> TableName
->     fieldName      FieldType
->     otherField     String
->     nullableField  (Maybe Int)
-
-However, note, the field _must_ be enclosed in parenthesis.
-
-== @sqltype=@
-
-By default, Persistent maps the Haskell types you specify in the Models DSL to
-an appropriate SQL type in the database (refer to the section "Conversion table
-(migrations)" for the default mappings). Using the
-@sqltype=@ option, you can  customize the SQL type Persistent uses for your
-column. Use cases include:
-
-* Interacting with an existing database whose column types don't match Persistent's defaults.
-* Taking advantage of a specific SQL type's features
-    * e.g. Using an equivalent type that has better space or performance characteristics
-
-To use this setting, add the @sqltype=@ option after declaring your field name and type:
-
-@
-User
-    username Text sqltype=varchar(255)
-@
-
-== Laziness
-
-By default the records created by persistent have strict fields. You can prefix
-a field name with @~@ to make it lazy (or @!@ to make it strict).
-
-== Attributes
-
-The QuasiQuoter allows you to provide arbitrary attributes to an entity or field.
-This can be used to extend the code in ways that the library hasn't anticipated.
-If you use this feature, we'd definitely appreciate hearing about it and
-potentially supporting your use case directly!
-
-@
-User !funny
-    field   String  !sad
-    good    Dog     !sogood
-@
-
-We can see the attributes using the 'entityAttrs' field and the 'fieldAttrs' field.
-
-@
-userAttrs = do
-    let userDefinition = 'entityDef' ('Proxy' :: 'Proxy' User)
-    let userAttributes = 'entityAttrs' userDefinition
-    let fieldAttributes = 'map' 'fieldAttrs' ('entityFields' userDefinition)
-    print userAttributes
--- ["funny"]
-    print fieldAttributes
--- [["sad"],["sogood"]]
-@
-
-== @!no-migrate@
-
-To prevent @migrateModels@ from generating _any_ migrations for an entity, add
-the @!no-migrate@ attribute to it's definition:
-
-@
-User !no-migrate
-    field   String
-    good    Dog
-@
-
-== @MigrationOnly@
-
-Introduced with @persistent-template@ 1.2.0. The purpose of this attribute is
-to mark a field which will be entirely ignored by the normal processing, but
-retained in the database definition for purposes of migration. This means, in
-SQL, a column will not be flagged for removal by the migration scripts, even
-though it is not used in your code. This is useful for phasing out usage of a
-column before entirely removing it, or having columns which are needed by other
-tools but not by Persistent.
-
-@
-Person
-    name Text
-    age Int
-    unusedField ByteString Maybe MigrationOnly
-@
-
-Note that you almost certainly want to either mark the field as @Maybe@ or
-provide a default value, otherwise insertions will fail.
-
-
-== @SafeToRemove@
-
-This is intended to be used as part of a deprecation of a field, after
-@MigrationOnly@ has been used usually. This works somewhat as a superset of the
-functionality of @MigrationOnly@. In addition, the field will be removed from
-the database if it is present. Note that this is a destructive change which you
-are marking as safe.
-
-== Constraints
-
-Migration will remove any manual constraints from your tables. Exception: constraints whose names begin with the string @__manual_@ (which starts with two underscores) will be preserved.
-
-
-= Foreign Keys
-
-If you define an entity and want to refer to it in another table, you can use the entity's Id type in a column directly.
-
-@
-Person
-    name    Text
-
-Dog
-    name    Text
-    owner   PersonId
-@
-
-This automatically creates a foreign key reference from @Dog@ to @Person@.
-The foreign key constraint means that, if you have a @PersonId@ on the @Dog@, the database guarantees that the corresponding @Person@ exists in the database.
-If you try to delete a @Person@ out of the database that has a @Dog@, you'll receive an exception that a foreign key violation has occurred.
-
-== @constraint=@
-
-You can use the @constraint=@ attribute to override the constraint name used in
-migrations. This is useful particularly when the automatically generated
-constraint names exceed database limits (e.g. MySQL does not allow constraint
-names longer than 64 characters).
-
-@
-VeryLongTableName
-  name Text
-
-AnotherVeryLongTableName
-  veryLongTableNameId VeryLongTableNameId constraint=short_foreign_key
-@
-
-== OnUpdate and OnDelete
-
-These options affects how a referring record behaves when the target record is changed.
-There are several options:
-
-* 'Restrict' - This is the default. It prevents the action from occurring.
-* 'Cascade' - this copies the change to the child record. If a parent record is deleted, then the child record will be deleted too.
-* 'SetNull' - If the parent record is modified, then this sets the reference to @NULL@. This only works on @Maybe@ foreign keys.
-* 'SetDefault' - This will set the column's value to the @default@ for the column, if specified.
-
-To specify the behavior for a reference, write @OnUpdate@ or @OnDelete@ followed by the action.
-
-@
-Record
-    -- If the referred Foo is deleted or updated, then this record will
-    -- also be deleted or updated.
-    fooId   FooId   OnDeleteCascade OnUpdateCascade
-
-    -- If the referred Bar is deleted, then we'll set the reference to
-    -- 'Nothing'. If the referred Bar is updated, then we'll cascade the
-    -- update.
-    barId   BarId Maybe     OnDeleteSetNull OnUpdateCascade
-
-    -- If the referred Baz is deleted, then we set to the default ID.
-    bazId   BazId   OnDeleteSetDefault  default=1
-@
-
-Let's demonstrate this with a shopping cart example.
-
-@
-User
-    name    Text
-
-Cart
-    user    UserId Maybe
-
-CartItem
-    cartId  CartId
-    itemId  ItemId
-
-Item
-    name    Text
-    price   Int
-@
-
-Let's consider how we want to handle deletions and updates.
-If a @User@ is deleted or update, then we want to cascade the action to the associated @Cart@.
-
-@
-Cart
-    user    UserId Maybe OnDeleteCascade OnUpdateCascade
-@
-
-If an @Item@ is deleted, then we want to set the @CartItem@ to refer to a special "deleted item" in the database.
-If a @Cart@ is deleted, though, then we just want to delete the @CartItem@.
-
-@
-CartItem
-    cartId CartId   OnDeleteCascade
-    itemId ItemId   OnDeleteSetDefault default=1
-@
-
-== @Foreign@ keyword
-
-The above example is a "simple" foreign key. It refers directly to the Id column, and it only works with a non-composite primary key. We can define more complicated foreign keys using the @Foreign@ keyword.
-
-A pseudo formal syntax for @Foreign@ is:
-
-@
-Foreign $(TargetEntity) [$(cascade-actions)] $(constraint-name) $(columns) [ $(references) ]
-
-columns := column0 [column1 column2 .. columnX]
-references := References $(target-columns)
-target-columns := target-column0 [target-column1 target-columns2 .. target-columnX]
-@
-
-Columns are the columns as defined on this entity.
-@target-columns@ are the columns as defined on the target entity.
-
-Let's look at some examples.
-
-=== Composite Primary Key References
-
-The most common use for this is to refer to a composite primary key.
-Since composite primary keys take up more than one column, we can't refer to them with a single @persistent@ column.
-
-@
-Email
-    firstPart   Text
-    secondPart  Text
-    Primary firstPart secondPart
-
-User
-    name            Text
-    emailFirstPart  Text
-    emailSecondPart Text
-
-    Foreign Email fk_user_email emailFirstPart emailSecondPart
-@
-
-If you omit the @References@ keyword, then it assumes that the foreign key reference is for the target table's primary key.
-If we wanted to be fully redundant, we could specify the @References@ keyword.
-
-@
-    Foreign Email fk_user_email emailFirstPart emailSecondPart References firstPart secondPart
-@
-
-We can specify delete/cascade behavior directly after the target table.
-
-@
-    Foreign Email OnDeleteCascade OnUpdateCascade fk_user_email emailFirstPart emailSecondPart
-@
-
-Now, if the email is deleted or updated, the user will be deleted or updated to match.
-
-=== Non-Primary Key References
-
-SQL database backends allow you to create a foreign key to any column(s) with a Unique constraint.
-Persistent does not check this, because you might be defining your uniqueness constraints outside of Persistent.
-To do this, we must use the @References@ keyword.
-
-@
-User
-    name    Text
-    email   Text
-
-    UniqueEmail email
-
-Notification
-    content Text
-    sentTo  Text
-
-    Foreign User fk_noti_user sentTo References email
-@
-
-If the target uniqueness constraint has multiple columns, then you must specify them independently.
-
-@
-User
-    name            Text
-    emailFirst      Text
-    emailSecond     Text
-
-    UniqueEmail emailFirst emailSecond
-
-Notification
-    content         Text
-    sentToFirst     Text
-    sentToSecond    Text
-
-    Foreign User fk_noti_user sentToFirst sentToSecond References emailFirst emailSecond
-@
-
-= Documentation Comments
-
-The quasiquoter supports ordinary comments with @--@ and @#@.
-Since @persistent-2.10.5.1@, it also supports documentation comments.
-The grammar for documentation comments is similar to Haskell's Haddock syntax, with a few restrictions:
-
-1. Only the @-- | @ form is allowed.
-2. You must put a space before and after the @|@ pipe character.
-3. The comment must be indented at the same level as the entity or field it documents.
-
-An example of the field documentation is:
-
-@
--- | I am a doc comment for a User. Users are important
--- | to the application, and should be treasured.
-User
-    -- | Users have names. Call them by names.
-    name String
-    -- | A user can be old, or young, and we care about
-    -- | this for some reason.
-    age Int
-@
-
-The documentation is present on the @entityComments@ field on the @EntityDef@ for the entity:
-
-@
->>> let userDefinition = entityDef (Proxy :: Proxy User)
->>> entityComments userDefinition
-"I am a doc comment for a User. Users are important\nto the application, and should be treasured.\n"
-@
-
-Likewise, the field documentation is present in the @fieldComments@ field on the @FieldDef@ present in the @EntityDef@:
-
-@
->>> let userFields = entityFields userDefinition
->>> let comments = map fieldComments userFields
->>> mapM_ putStrLn comments
-"Users have names. Call them by names."
-"A user can be old, or young, and we care about\nthis for some reason."
-@
-
-Since @persistent-2.14.6.0@, documentation comments are included in documentation generated using Haddock if `mpsEntityHaddocks` is enabled (defaults to False).
-@persistent@ backends can also use this to generate SQL @COMMENT@s, which are useful for a database perspective, and you can use the <https://hackage.haskell.org/package/persistent-documentation @persistent-documentation@> library to render a Markdown document of the entity definitions.
-
-= Sum types
-
-== Field level
-
-You'll frequently want to store an enum of values in your database. For
-example, you might describe a @Person@'s employment status as being @Employed@,
-@Unemployed@, or @Retired@. In Haskell this is represented with a sum type, and
-Persistent provides a Template Haskell function to marshall these values to and
-from the database:
-
-@
--- @Employment.hs
-{-# LANGUAGE TemplateHaskell #-}
-module Employment where
-
-import Database.Persist.TH
-import Prelude
-
-data Employment = Employed | Unemployed | Retired
-    deriving (Show, Read, Eq)
-derivePersistField "Employment"
-@
-
-@derivePersistField@ stores sum type values as strins in the database. While not as efficient as using integers, this approach simplifies adding and removing values from your enumeration.
-
-Due to the GHC Stage Restriction, the call to the Template Haskell function @derivePersistField@ must be in a separate module than where the generated code is used.
-
-Note: If you created a new module, make sure add it to the @exposed-modules@ section of your Cabal file.
-
-Use the module by importing it into your @Model.hs@ file:
-
-@
--- @Model.hs
-import Employment
-@
-
-and use it in the @models@ DSL:
-
-@
-Person
-    employment Employment
-@
-
-You can export the Employment module from Import to use it across your app:
-
-@
--- @Import.hs
-import Employment as Import
-@
-
-=== Entity-level
-
-NOTE: This feature is deprecated as of version 2.14 and will be removed in 2.15 (unless there are many complaints).
-
-The
-<https://github.com/yesodweb/persistent/blob/master/persistent-test/src/SumTypeTest.hs#L35 tests for this feature>
-demonstrate their usage. Note the use of the sign @+@ in front of the entity
-name.
-
-The schema in the test is reproduced here:
-
-@
-share [mkPersist persistSettings, mkMigrate "sumTypeMigrate"] [persistLowerCase|
-Bicycle
-    brand T.Text
-Car
-    make T.Text
-    model T.Text
-+Vehicle
-    bicycle BicycleId
-    car CarId
-|]
-@
-
-Let's check out the definition of the Haskell type @Vehicle@.
-Using @ghci@, we can query for @:info Vehicle@:
-
->>> :i Vehicle
-type Vehicle = VehicleGeneric SqlBackend
-        -- Defined at .../Projects/persistent/persistent-test/src/SumTypeTest.hs:26:1
-
->>> :i VehicleGeneric
-type role VehicleGeneric nominal
-data VehicleGeneric backend
-  = VehicleBicycleSum (Key (BicycleGeneric backend))
-  | VehicleCarSum (Key (CarGeneric backend))
-        -- Defined at .../persistent/persistent-test/src/SumTypeTest.hs:26:1
--- lots of instances follow...
-
-A @VehicleGeneric@ has two constructors:
-
-- @VehicleBicycleSum@ with a @Key (BicycleGeneric backend)@ field
-- @VehicleCarSum@ with a @Key (CarGeneric backend)@ field
-
-The @Bicycle@ and @Car@ are typical @persistent@ entities.
-
-This generates the following SQL migrations (formatted for readability):
-
-@
-CREATE TABLE "bicycle" (
-    "id"        INTEGER PRIMARY KEY,
-    "brand"     VARCHAR NOT NULL
-);
-
-CREATE TABLE "car"(
-    "id"        INTEGER PRIMARY KEY,
-    "make"      VARCHAR NOT NULL,
-    "model"     VARCHAR NOT NULL
-);
-
-CREATE TABLE "vehicle"(
-    "id"        INTEGER PRIMARY KEY,
-    "bicycle"   INTEGER NULL REFERENCES "bicycle",
-    "car"       INTEGER NULL REFERENCES "car"
-);
-@
-
-The @vehicle@ table contains a nullable foreign key reference to both the bicycle and the car tables.
-
-A SQL query that grabs all the vehicles from the database looks like this (note the @??@ is for the @persistent@ raw SQL query functions):
-
-@
-SELECT ??, ??, ??
-FROM vehicle
-LEFT JOIN car
-    ON vehicle.car = car.id
-LEFT JOIN bicycle
-    ON vehicle.bicycle = bicycle.id
-@
-
-If we use the above query with @rawSql@, we'd get the following result:
-
-@
-getVehicles
-    :: SqlPersistM
-        [ ( Entity Vehicle
-          , Maybe (Entity Bicycle)
-          , Maybe (Entity Car)
-          )
-        ]
-@
-
-This result has some post-conditions that are not guaranteed by the types *or* the schema.
-The constructor for @Entity Vehicle@ is going to determine which of the other members of the tuple is @Nothing@.
-We can convert this to a friendlier domain model like this:
-
-@
-data Vehicle'
-    = Car' Text Text
-    | Bike Text
-
-check = do
-    result <- getVehicles
-    pure (map convert result)
-
-convert
-    :: (Entity Vehicle, Maybe (Entity Bicycle), Maybe (Entity Car))
-    -> Vehicle'
-convert (Entity _ (VehicycleBicycleSum _), Just (Entity _ (Bicycle brand)), _) =
-    Bike brand
-convert (Entity _ (VehicycleCarSum _), _, Just (Entity _ (Car make model))) =
-    Car make model
-convert _ =
-    error "The database preconditions have been violated!"
-@
-
-== Times with timezones
-
-Storing times with timezones in one type in databases is not possible, although
-it seems that it should be possible (@timezone@ and @timezonetz@ in
-PostgreSQL). That's why starting with persistent 2.0, all times will be mapped
-to @UTCTime@. If you need to store timezone information along with times in a
-database, store the timezone in a second field. Here are some links about the
-topic with further information:
-
-* https://github.com/yesodweb/persistent/issues/290
-* https://groups.google.com/forum/#!msg/yesodweb/MIfcV2bwM80/8QLFpgp1LykJ
-* http://stackoverflow.com/questions/14615271/postgres-timestamp/14616640#14616640
-* http://justatheory.com/computers/databases/postgresql/use-timestamptz.html
-* https://github.com/lpsmith/postgresql-simple/issues/69
-* https://github.com/nikita-volkov/hasql-postgres/issues/1
-
-= Conversion table (migrations)
-
-Here are the conversions between Haskell types and database types:
-
-+------------+----------------------+-------------------+---------------+----------------+
-| Haskell    | PostgreSQL           | MySQL             | MongoDB       |  SQLite        |
-+============+======================+===================+===============+================+
-| Text       |  VARCHAR             |  TEXT             | String        |  VARCHAR       |
-+------------+----------------------+-------------------+---------------+----------------+
-| ByteString |  BYTEA               |  BLOB             | BinData       |  BLOB          |
-+------------+----------------------+-------------------+---------------+----------------+
-| Int        |  INT8                |  BIGINT(20)       | NumberLong    |  INTEGER       |
-+------------+----------------------+-------------------+---------------+----------------+
-| Double     |  DOUBLE PRECISION    |  DOUBLE           | Double        |  REAL          |
-+------------+----------------------+-------------------+---------------+----------------+
-| Rational   |  NUMERIC(22, 12)     |  DECIMAL(32,20)   | *Unsupported* |  NUMERIC(32,20)|
-+------------+----------------------+-------------------+---------------+----------------+
-| Bool       |  BOOLEAN             |  TINYINT(1)       | Boolean       |  BOOLEAN       |
-+------------+----------------------+-------------------+---------------+----------------+
-| Day        |  DATE                |  DATE             | NumberLong    |  DATE          |
-+------------+----------------------+-------------------+---------------+----------------+
-| TimeOfDay  |  TIME                |  TIME\*\*         | *Unsupported* |  TIME          |
-+------------+----------------------+-------------------+---------------+----------------+
-| UTCTime\*  |  TIMESTAMP           |  DATETIME\*\*     | Date          |  TIMESTAMP     |
-+------------+----------------------+-------------------+---------------+----------------+
-
-Notes:
-
-\* Support for @ZonedTime@ was dropped in persistent 2.0. @UTCTime@ can be used
-with @timestamp without timezone@ and @timestamp with timezone@ in PostgreSQL.
-See also the section "Times with timezones".
-
-\*\* The default resolution for @TIME@ and @DATETIME@ in MySQL is one second.
-As of MySQL version 5.6.4, and persistent-mysql-2.6.2, fractional seconds are
-handled correctly if you declare an explicit precision by using @sqltype@. For
-example, appending @sqltype=TIME(6)@ to a @TimeOfDay@ field definition will
-give microsecond resolution.
-
-= Compatibility tables
-
-MySQL:
-
-+-------------------+-----------------------------------------------------------------------+
-|Haskell type       | Compatible MySQL types                                                |
-+===================+=======================================================================+
-| Bool              | Tiny                                                                  |
-+-------------------+-----------------------------------------------------------------------+
-| Int8              | Tiny                                                                  |
-+-------------------+-----------------------------------------------------------------------+
-| Int16             | Tiny,Short                                                            |
-+-------------------+-----------------------------------------------------------------------+
-| Int32             | Tiny,Short,Int24,Long                                                 |
-+-------------------+-----------------------------------------------------------------------+
-| Int               | Tiny,Short,Int24,Long,LongLong\*                                      |
-+-------------------+-----------------------------------------------------------------------+
-| Int64             | Tiny,Short,Int24,Long,LongLong                                        |
-+-------------------+-----------------------------------------------------------------------+
-| Integer           | Tiny,Short,Int24,Long,LongLong                                        |
-+-------------------+-----------------------------------------------------------------------+
-| Word8             | Tiny                                                                  |
-+-------------------+-----------------------------------------------------------------------+
-| Word16            | Tiny,Short                                                            |
-+-------------------+-----------------------------------------------------------------------+
-| Word32            | Tiny,Short,Int24,Long                                                 |
-+-------------------+-----------------------------------------------------------------------+
-| Word64            | Tiny,Short,Int24,Long,LongLong                                        |
-| Double            | Float,Double,Decimal,NewDecimal,Tiny,Short,Int24,Long                 |
-+-------------------+-----------------------------------------------------------------------+
-| Ratio Integer     | Float,Double,Decimal,NewDecimal,Tiny,Short,Int24,Long,LongLong        |
-+-------------------+-----------------------------------------------------------------------+
-| ByteString        | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
-+-------------------+-----------------------------------------------------------------------+
-| Lazy.ByteString   | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
-+-------------------+-----------------------------------------------------------------------+
-| Encoding.Text\*\* | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
-+-------------------+-----------------------------------------------------------------------+
-| Lazy.Text         | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
-+-------------------+-----------------------------------------------------------------------+
-| [Char]/String     | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
-+-------------------+-----------------------------------------------------------------------+
-| UTCTime           | DateTime,Timestamp                                                    |
-+-------------------+-----------------------------------------------------------------------+
-| Day               | Year,Date,NewDate                                                     |
-+-------------------+-----------------------------------------------------------------------+
-| TimeOfDay         | Time                                                                  |
-+-------------------+-----------------------------------------------------------------------+
-
-\* When @Word@ size is 64bit
-
-\*\* Utf8 only
-
-Unsupported types:
-
-+--------------------------------------------------------------------+
-| Not currently supported                                            |
-+====================================================================+
-| Word                                                               |
-+--------------------------------------------------------------------+
-| Float                                                              |
-+--------------------------------------------------------------------+
-| Scientific <https://github.com/yesodweb/persistent/issues/225 #225>|
-+--------------------------------------------------------------------+
-
-See <http://hackage.haskell.org/package/mysql-simple/docs/Database-MySQL-Simple-Result.html MySQL.Simple.Result>.
--}
-module Database.Persist.Quasi
-    ( parse
-    -- * 'PersistSettings'
-    , PersistSettings
-    , upperCaseSettings
-    , lowerCaseSettings
-    -- ** Getters and Setters
-    , getPsToDBName
-    , setPsToDBName
-    , setPsToFKName
-    , setPsUseSnakeCaseForeignKeys
-    , setPsUseSnakeCaseForiegnKeys
-    , getPsStrictFields
-    , setPsStrictFields
-    , getPsIdName
-    , setPsIdName
-    , getPsTabErrorLevel
-    , setPsTabErrorLevel
-    ) where
-
-import Database.Persist.Quasi.PersistSettings
-import Database.Persist.Quasi.Internal
+-- |
+-- This module defines the Persistent entity syntax used in the quasiquoter to generate persistent entities.
+--
+-- The basic structure of the syntax looks like this:
+--
+-- > TableName
+-- >     fieldName      FieldType
+-- >     otherField     String
+-- >     nullableField  Int       Maybe
+--
+-- You start an entity definition with the table name, in this case, @TableName@. It's followed by a list of fields on the entity, which have the basic form @fieldName FieldType@. You can indicate that a field is nullable with 'Maybe' at the end of the type.
+--
+-- @persistent@ automatically generates an ID column for you, if you don't specify one, so the above table definition corresponds to the following SQL:
+--
+-- > CREATE TABLE table_name (
+-- >     id                SERIAL PRIMARY KEY,
+-- >     field_name        field_type NOT NULL,
+-- >     other_field       varchar    NOT NULL,
+-- >     nullable_field    int NULL
+-- > );
+--
+-- Note that the exact SQL that is generated can be customized using the 'PersistSettings' that are passed to the 'parse' function.
+--
+-- It generates a Haskell datatype with the following form:
+--
+-- @
+-- data TableName = TableName
+--     { tableNameFieldName :: FieldType
+--     , tableNameOtherField :: String
+--     , tableNameNullableField :: Maybe Int
+--     }
+-- @
+--
+-- As with the SQL generated, the specifics of this are customizable.
+-- See the "Database.Persist.TH" module for details.
+--
+-- = Deriving
+--
+-- You can add a deriving clause to a table, and the generated Haskell type will have a deriving clause with that.
+-- Unlike normal Haskell syntax, you don't need parentheses or commas to separate the classes, and you can even have multiple deriving clauses.
+--
+-- > User
+-- >     name String
+-- >     age  Int
+-- >     deriving Eq Show
+-- >     deriving Ord
+--
+-- = Unique Keys
+--
+-- You can define a uniqueness key on a table with the following format:
+--
+-- > User
+-- >    name String
+-- >    age  Int
+-- >
+-- >    UniqueUserName name
+--
+-- This will put a unique index on the @user@ table and the @name@ field.
+--
+-- = Setting defaults
+--
+-- You can use a @default=${sql expression}@ clause to set a default for a field.
+-- The thing following the @=@ is interpreted as SQL that will be put directly into the table definition.
+--
+-- @
+-- User
+--     name    Text
+--     admin   Bool default=false
+-- @
+--
+-- This creates a SQL definition like this:
+--
+-- > CREATE TABLE user (
+-- >   id      SERIAL PRIMARY KEY,
+-- >   name    VARCHAR NOT NULL,
+-- >   admin   BOOL DEFAULT=false
+-- > );
+--
+-- A restriction here is that you still need to provide a value when performing an @insert@, because the generated Haskell type has the form:
+--
+-- @
+-- data User = User
+--     { userName :: Text
+--     , userAdmin :: Bool
+--     }
+-- @
+--
+-- You can work around this by using a 'Maybe Bool' and supplying 'Nothing' by default.
+--
+-- __Note__: Persistent determines whether or not to migrate a column's default
+-- value by comparing the exact string found in your @models@ file with the one
+-- returned by the database. If a database canonicalizes the SQL @FALSE@ from your
+-- @models@ file to @false@ in the database, Persistent will think the default
+-- value needs to be migrated and
+-- <https://github.com/yesodweb/persistent/issues/241 attempt a migration each time you start your app>.
+--
+-- To workaround this, find the exact SQL your DBMS uses for the default value. For example, using postgres:
+--
+-- @
+-- psql database_name # Open postgres
+--
+-- \\d+ table_name -- describe the table schema
+-- @
+--
+-- @
+-- ...
+-- created       | timestamp without time zone | not null default now()
+-- @
+--
+-- Then use the listed default value SQL inside your @models@ file.
+--
+-- = Custom ID column
+--
+-- If you don't want to use the default ID column type of 'Int64', you can set a custom type with an @Id@ field.
+-- This @User@ has a @Text@ ID.
+--
+-- > User
+-- >     Id   Text
+-- >     name Text
+-- >     age  Int
+--
+-- If you do this, it's a good idea to set a default for the ID.
+-- Otherwise, you will need to use 'insertKey' instead of 'insert' when performing inserts.
+--
+-- @
+-- 'insertKey' (UserKey "Hello world!") (User "Bob" 32)
+-- @
+--
+-- If you attempt to do @'insert' (User "Bob" 32)@, then you will receive a runtime error because the SQL database doesn't know how to make an ID for you anymore.
+-- So instead just use a default expression, like this:
+--
+-- @
+-- User
+--     Id      Text default=generate_user_id()
+--     name    Text
+--     age     Int
+-- @
+--
+-- = Custom Primary Keys
+--
+-- Sometimes you don't want to have an ID column, and you want a different sort of primary key.
+-- This is a table that stores unique email addresses, and the email is the primary key.
+-- We store the first and second part (eg @first\@second@) separately.
+--
+-- @
+-- Email
+--     firstPart   Text
+--     secondPart  Text
+--
+--     Primary firstPart secondPart
+-- @
+--
+-- This creates a table with the following form:
+--
+-- @
+-- CREATE TABLE email (
+--     first_part  varchar,
+--     second_part varchar,
+--
+--     PRIMARY KEY (first_part, second_part)
+-- @
+--
+-- Since the primary key for this table is part of the record, it's called a "natural key" in the SQL lingo.
+-- As a key with multiple fields, it is also a "composite key."
+--
+-- You can specify a @Primary@ key with a single field, too.
+--
+-- = Overriding SQL
+--
+-- You can use a @sql=custom@ annotation to provide some customization on the entity and field.
+-- For example, you might prefer to name a table differently than what @persistent@ will do by default.
+-- You may also prefer to name a field differently.
+--
+-- @
+-- User sql=big_user_table
+--     fullName    String sql=name
+--     age         Int
+-- @
+--
+-- This will alter the generated SQL to be:
+--
+-- @
+-- CREATE TABLE big_user_table (
+--     id      SERIAL PRIMARY KEY,
+--     name    VARCHAR,
+--     age     INT
+-- );
+-- @
+--
+-- = Customizing Types/Tables
+--
+-- == JSON instances
+--
+-- You can automatically get ToJSON and FromJSON instances for any entity by adding @json@ to the entity line:
+--
+-- @
+-- Person json
+--     name Text
+-- @
+-- Requires @\{\-\# LANGUAGE FlexibleInstances \#\-\}@
+--
+-- Customizable by using mpsEntityJSON
+-- * http://hackage.haskell.org/package/persistent-template/docs/Database-Persist-TH.html#v:EntityJSON
+-- * http://hackage.haskell.org/package/persistent/docs/Database-Persist-Class.html#v:keyValueEntityToJSON
+--
+-- == Changing table/collection name
+--
+-- @
+-- Person sql=peoples
+--     name Text
+-- @
+--
+-- == Change table/collection key definition (field name and\/or type, persistent >= 2.1)
+--
+-- @Id@ defines the column to use to define the key of the entity.
+-- Without type, the default backend key type will be used. You can change its
+-- database name using the @sql@ attributes :
+--
+-- @
+-- Person
+--    Id         sql=my_id_name
+--    phone Text
+-- @
+--
+-- With a Haskell type, the corresponding type is used. Note that you'll need to
+-- use @default=@ to tell it what to do on insertion.
+--
+-- @
+-- Person
+--    Id    Day default=CURRENT_DATE
+--    phone Text
+-- @
+--
+-- @default=@ works for SQL databases, and is backend specific.
+-- For MongoDB currently one always needs to create the key on the application
+-- side and use @insertKey@. @insert@ will not work correctly. Sql backends can
+-- also do this if default does not work.
+--
+-- @sqltype@ can also be used to specify a different database type
+--
+-- @
+-- Currency
+--     Id String sqltype=varchar(3) sql=code
+-- @
+--
+-- Composite key (using multiple columns) can also be defined using @Primary@.
+--
+-- @sql=@ also works for setting the names of unique indexes.
+--
+-- @
+-- Person
+--   name Text
+--   phone Text
+--   UniquePersonPhone phone sql=UniqPerPhone
+-- @
+--
+-- This makes a unique index requiring @phone@ to be unique across @Person@ rows.
+-- Ordinarily Persistent will generate a snake-case index name from the
+-- capitalized name provided such that @UniquePersonPhone@ becomes
+-- @unique_person_phone@. However, we provided a @sql=@ so the index name in the
+-- database will instead be @UniqPerPhone@. Keep in mind @sql=@ and @!@ attrs must
+-- come after the list of fields in front of the index name in the quasi-quoter.
+--
+--
+--
+-- = Customizing Fields
+--
+-- == Nullable Fields
+--
+-- As illustrated in the example at the beginning of this page, we are able to represent nullable
+-- fields by including 'Maybe' at the end of the type declaration:
+--
+-- > TableName
+-- >     fieldName      FieldType
+-- >     otherField     String
+-- >     nullableField  Int       Maybe
+--
+-- Alternatively we can specify the keyword nullable:
+--
+-- > TableName
+-- >     fieldName      FieldType
+-- >     otherField     String
+-- >     nullableField  Int       nullable
+--
+-- However the difference here is in the first instance the Haskell type will be 'Maybe Int',
+-- but in the second it will be 'Int'. Be aware that this will cause runtime errors if the
+-- database returns @NULL@ and the @PersistField@ instance does not handle @PersistNull@.
+--
+-- If you wish to define your Maybe types in a way that is similar to the actual Haskell
+-- definition, you can define 'Maybe Int' like so:
+--
+-- > TableName
+-- >     fieldName      FieldType
+-- >     otherField     String
+-- >     nullableField  (Maybe Int)
+--
+-- However, note, the field _must_ be enclosed in parenthesis.
+--
+-- == @sqltype=@
+--
+-- By default, Persistent maps the Haskell types you specify in the Models DSL to
+-- an appropriate SQL type in the database (refer to the section "Conversion table
+-- (migrations)" for the default mappings). Using the
+-- @sqltype=@ option, you can  customize the SQL type Persistent uses for your
+-- column. Use cases include:
+--
+-- * Interacting with an existing database whose column types don't match Persistent's defaults.
+-- * Taking advantage of a specific SQL type's features
+--     * e.g. Using an equivalent type that has better space or performance characteristics
+--
+-- To use this setting, add the @sqltype=@ option after declaring your field name and type:
+--
+-- @
+-- User
+--     username Text sqltype=varchar(255)
+-- @
+--
+-- == Laziness
+--
+-- By default the records created by persistent have strict fields. You can prefix
+-- a field name with @~@ to make it lazy (or @!@ to make it strict).
+--
+-- == Attributes
+--
+-- The QuasiQuoter allows you to provide arbitrary attributes to an entity or field.
+-- This can be used to extend the code in ways that the library hasn't anticipated.
+-- If you use this feature, we'd definitely appreciate hearing about it and
+-- potentially supporting your use case directly!
+--
+-- @
+-- User !funny
+--     field   String  !sad
+--     good    Dog     !sogood
+-- @
+--
+-- We can see the attributes using the 'entityAttrs' field and the 'fieldAttrs' field.
+--
+-- @
+-- userAttrs = do
+--     let userDefinition = 'entityDef' ('Proxy' :: 'Proxy' User)
+--     let userAttributes = 'entityAttrs' userDefinition
+--     let fieldAttributes = 'map' 'fieldAttrs' ('entityFields' userDefinition)
+--     print userAttributes
+-- -- ["funny"]
+--     print fieldAttributes
+-- -- [["sad"],["sogood"]]
+-- @
+--
+-- == @!no-migrate@
+--
+-- To prevent @migrateModels@ from generating _any_ migrations for an entity, add
+-- the @!no-migrate@ attribute to it's definition:
+--
+-- @
+-- User !no-migrate
+--     field   String
+--     good    Dog
+-- @
+--
+-- == @MigrationOnly@
+--
+-- Introduced with @persistent-template@ 1.2.0. The purpose of this attribute is
+-- to mark a field which will be entirely ignored by the normal processing, but
+-- retained in the database definition for purposes of migration. This means, in
+-- SQL, a column will not be flagged for removal by the migration scripts, even
+-- though it is not used in your code. This is useful for phasing out usage of a
+-- column before entirely removing it, or having columns which are needed by other
+-- tools but not by Persistent.
+--
+-- @
+-- Person
+--     name Text
+--     age Int
+--     unusedField ByteString Maybe MigrationOnly
+-- @
+--
+-- Note that you almost certainly want to either mark the field as @Maybe@ or
+-- provide a default value, otherwise insertions will fail.
+--
+--
+-- == @SafeToRemove@
+--
+-- This is intended to be used as part of a deprecation of a field, after
+-- @MigrationOnly@ has been used usually. This works somewhat as a superset of the
+-- functionality of @MigrationOnly@. In addition, the field will be removed from
+-- the database if it is present. Note that this is a destructive change which you
+-- are marking as safe.
+--
+-- == Constraints
+--
+-- Migration will remove any manual constraints from your tables. Exception: constraints whose names begin with the string @__manual_@ (which starts with two underscores) will be preserved.
+--
+--
+-- = Foreign Keys
+--
+-- If you define an entity and want to refer to it in another table, you can use the entity's Id type in a column directly.
+--
+-- @
+-- Person
+--     name    Text
+--
+-- Dog
+--     name    Text
+--     owner   PersonId
+-- @
+--
+-- This automatically creates a foreign key reference from @Dog@ to @Person@.
+-- The foreign key constraint means that, if you have a @PersonId@ on the @Dog@, the database guarantees that the corresponding @Person@ exists in the database.
+-- If you try to delete a @Person@ out of the database that has a @Dog@, you'll receive an exception that a foreign key violation has occurred.
+--
+-- == @constraint=@
+--
+-- You can use the @constraint=@ attribute to override the constraint name used in
+-- migrations. This is useful particularly when the automatically generated
+-- constraint names exceed database limits (e.g. MySQL does not allow constraint
+-- names longer than 64 characters).
+--
+-- @
+-- VeryLongTableName
+--   name Text
+--
+-- AnotherVeryLongTableName
+--   veryLongTableNameId VeryLongTableNameId constraint=short_foreign_key
+-- @
+--
+-- == OnUpdate and OnDelete
+--
+-- These options affects how a referring record behaves when the target record is changed.
+-- There are several options:
+--
+-- * 'Restrict' - This is the default. It prevents the action from occurring.
+-- * 'Cascade' - this copies the change to the child record. If a parent record is deleted, then the child record will be deleted too.
+-- * 'SetNull' - If the parent record is modified, then this sets the reference to @NULL@. This only works on @Maybe@ foreign keys.
+-- * 'SetDefault' - This will set the column's value to the @default@ for the column, if specified.
+--
+-- To specify the behavior for a reference, write @OnUpdate@ or @OnDelete@ followed by the action.
+--
+-- @
+-- Record
+--     -- If the referred Foo is deleted or updated, then this record will
+--     -- also be deleted or updated.
+--     fooId   FooId   OnDeleteCascade OnUpdateCascade
+--
+--     -- If the referred Bar is deleted, then we'll set the reference to
+--     -- 'Nothing'. If the referred Bar is updated, then we'll cascade the
+--     -- update.
+--     barId   BarId Maybe     OnDeleteSetNull OnUpdateCascade
+--
+--     -- If the referred Baz is deleted, then we set to the default ID.
+--     bazId   BazId   OnDeleteSetDefault  default=1
+-- @
+--
+-- Let's demonstrate this with a shopping cart example.
+--
+-- @
+-- User
+--     name    Text
+--
+-- Cart
+--     user    UserId Maybe
+--
+-- CartItem
+--     cartId  CartId
+--     itemId  ItemId
+--
+-- Item
+--     name    Text
+--     price   Int
+-- @
+--
+-- Let's consider how we want to handle deletions and updates.
+-- If a @User@ is deleted or update, then we want to cascade the action to the associated @Cart@.
+--
+-- @
+-- Cart
+--     user    UserId Maybe OnDeleteCascade OnUpdateCascade
+-- @
+--
+-- If an @Item@ is deleted, then we want to set the @CartItem@ to refer to a special "deleted item" in the database.
+-- If a @Cart@ is deleted, though, then we just want to delete the @CartItem@.
+--
+-- @
+-- CartItem
+--     cartId CartId   OnDeleteCascade
+--     itemId ItemId   OnDeleteSetDefault default=1
+-- @
+--
+-- == @Foreign@ keyword
+--
+-- The above example is a "simple" foreign key. It refers directly to the Id column, and it only works with a non-composite primary key. We can define more complicated foreign keys using the @Foreign@ keyword.
+--
+-- A pseudo formal syntax for @Foreign@ is:
+--
+-- @
+-- Foreign $(TargetEntity) [$(cascade-actions)] $(constraint-name) $(columns) [ $(references) ]
+--
+-- columns := column0 [column1 column2 .. columnX]
+-- references := References $(target-columns)
+-- target-columns := target-column0 [target-column1 target-columns2 .. target-columnX]
+-- @
+--
+-- Columns are the columns as defined on this entity.
+-- @target-columns@ are the columns as defined on the target entity.
+--
+-- Let's look at some examples.
+--
+-- === Composite Primary Key References
+--
+-- The most common use for this is to refer to a composite primary key.
+-- Since composite primary keys take up more than one column, we can't refer to them with a single @persistent@ column.
+--
+-- @
+-- Email
+--     firstPart   Text
+--     secondPart  Text
+--     Primary firstPart secondPart
+--
+-- User
+--     name            Text
+--     emailFirstPart  Text
+--     emailSecondPart Text
+--
+--     Foreign Email fk_user_email emailFirstPart emailSecondPart
+-- @
+--
+-- If you omit the @References@ keyword, then it assumes that the foreign key reference is for the target table's primary key.
+-- If we wanted to be fully redundant, we could specify the @References@ keyword.
+--
+-- @
+--     Foreign Email fk_user_email emailFirstPart emailSecondPart References firstPart secondPart
+-- @
+--
+-- We can specify delete/cascade behavior directly after the target table.
+--
+-- @
+--     Foreign Email OnDeleteCascade OnUpdateCascade fk_user_email emailFirstPart emailSecondPart
+-- @
+--
+-- Now, if the email is deleted or updated, the user will be deleted or updated to match.
+--
+-- === Non-Primary Key References
+--
+-- SQL database backends allow you to create a foreign key to any column(s) with a Unique constraint.
+-- Persistent does not check this, because you might be defining your uniqueness constraints outside of Persistent.
+-- To do this, we must use the @References@ keyword.
+--
+-- @
+-- User
+--     name    Text
+--     email   Text
+--
+--     UniqueEmail email
+--
+-- Notification
+--     content Text
+--     sentTo  Text
+--
+--     Foreign User fk_noti_user sentTo References email
+-- @
+--
+-- If the target uniqueness constraint has multiple columns, then you must specify them independently.
+--
+-- @
+-- User
+--     name            Text
+--     emailFirst      Text
+--     emailSecond     Text
+--
+--     UniqueEmail emailFirst emailSecond
+--
+-- Notification
+--     content         Text
+--     sentToFirst     Text
+--     sentToSecond    Text
+--
+--     Foreign User fk_noti_user sentToFirst sentToSecond References emailFirst emailSecond
+-- @
+--
+-- = Documentation Comments
+--
+-- The quasiquoter supports ordinary comments with @--@ and @#@.
+-- Since @persistent-2.10.5.1@, it also supports documentation comments.
+-- The grammar for documentation comments is similar to Haskell's Haddock syntax, with a few restrictions:
+--
+-- 1. Only the @-- | @ form is allowed.
+-- 2. You must put a space before and after the @|@ pipe character.
+-- 3. The comment must be indented at the same level as the entity or field it documents.
+--
+-- An example of the field documentation is:
+--
+-- @
+-- -- | I am a doc comment for a User. Users are important
+-- -- | to the application, and should be treasured.
+-- User
+--     -- | Users have names. Call them by names.
+--     name String
+--     -- | A user can be old, or young, and we care about
+--     -- | this for some reason.
+--     age Int
+-- @
+--
+-- The documentation is present on the @entityComments@ field on the @EntityDef@ for the entity:
+--
+-- @
+-- >>> let userDefinition = entityDef (Proxy :: Proxy User)
+-- >>> entityComments userDefinition
+-- "I am a doc comment for a User. Users are important\nto the application, and should be treasured.\n"
+-- @
+--
+-- Likewise, the field documentation is present in the @fieldComments@ field on the @FieldDef@ present in the @EntityDef@:
+--
+-- @
+-- >>> let userFields = entityFields userDefinition
+-- >>> let comments = map fieldComments userFields
+-- >>> mapM_ putStrLn comments
+-- "Users have names. Call them by names."
+-- "A user can be old, or young, and we care about\nthis for some reason."
+-- @
+--
+-- Since @persistent-2.14.6.0@, documentation comments are included in documentation generated using Haddock if `mpsEntityHaddocks` is enabled (defaults to False).
+-- @persistent@ backends can also use this to generate SQL @COMMENT@s, which are useful for a database perspective, and you can use the <https://hackage.haskell.org/package/persistent-documentation @persistent-documentation@> library to render a Markdown document of the entity definitions.
+--
+-- = Sum types
+--
+-- == Field level
+--
+-- You'll frequently want to store an enum of values in your database. For
+-- example, you might describe a @Person@'s employment status as being @Employed@,
+-- @Unemployed@, or @Retired@. In Haskell this is represented with a sum type, and
+-- Persistent provides a Template Haskell function to marshall these values to and
+-- from the database:
+--
+-- @
+-- -- @Employment.hs
+-- {-# LANGUAGE TemplateHaskell #-}
+-- module Employment where
+--
+-- import Database.Persist.TH
+-- import Prelude
+--
+-- data Employment = Employed | Unemployed | Retired
+--     deriving (Show, Read, Eq)
+-- derivePersistField "Employment"
+-- @
+--
+-- @derivePersistField@ stores sum type values as strins in the database. While not as efficient as using integers, this approach simplifies adding and removing values from your enumeration.
+--
+-- Due to the GHC Stage Restriction, the call to the Template Haskell function @derivePersistField@ must be in a separate module than where the generated code is used.
+--
+-- Note: If you created a new module, make sure add it to the @exposed-modules@ section of your Cabal file.
+--
+-- Use the module by importing it into your @Model.hs@ file:
+--
+-- @
+-- -- @Model.hs
+-- import Employment
+-- @
+--
+-- and use it in the @models@ DSL:
+--
+-- @
+-- Person
+--     employment Employment
+-- @
+--
+-- You can export the Employment module from Import to use it across your app:
+--
+-- @
+-- -- @Import.hs
+-- import Employment as Import
+-- @
+--
+-- === Entity-level
+--
+-- NOTE: This feature is deprecated as of version 2.14 and will be removed in 2.15 (unless there are many complaints).
+--
+-- The
+-- <https://github.com/yesodweb/persistent/blob/master/persistent-test/src/SumTypeTest.hs#L35 tests for this feature>
+-- demonstrate their usage. Note the use of the sign @+@ in front of the entity
+-- name.
+--
+-- The schema in the test is reproduced here:
+--
+-- @
+-- share [mkPersist persistSettings, mkMigrate "sumTypeMigrate"] [persistLowerCase|
+-- Bicycle
+--     brand T.Text
+-- Car
+--     make T.Text
+--     model T.Text
+-- +Vehicle
+--     bicycle BicycleId
+--     car CarId
+-- |]
+-- @
+--
+-- Let's check out the definition of the Haskell type @Vehicle@.
+-- Using @ghci@, we can query for @:info Vehicle@:
+--
+-- >>> :i Vehicle
+-- type Vehicle = VehicleGeneric SqlBackend
+--         -- Defined at .../Projects/persistent/persistent-test/src/SumTypeTest.hs:26:1
+--
+-- >>> :i VehicleGeneric
+-- type role VehicleGeneric nominal
+-- data VehicleGeneric backend
+--   = VehicleBicycleSum (Key (BicycleGeneric backend))
+--   | VehicleCarSum (Key (CarGeneric backend))
+--         -- Defined at .../persistent/persistent-test/src/SumTypeTest.hs:26:1
+-- -- lots of instances follow...
+--
+-- A @VehicleGeneric@ has two constructors:
+--
+-- - @VehicleBicycleSum@ with a @Key (BicycleGeneric backend)@ field
+-- - @VehicleCarSum@ with a @Key (CarGeneric backend)@ field
+--
+-- The @Bicycle@ and @Car@ are typical @persistent@ entities.
+--
+-- This generates the following SQL migrations (formatted for readability):
+--
+-- @
+-- CREATE TABLE "bicycle" (
+--     "id"        INTEGER PRIMARY KEY,
+--     "brand"     VARCHAR NOT NULL
+-- );
+--
+-- CREATE TABLE "car"(
+--     "id"        INTEGER PRIMARY KEY,
+--     "make"      VARCHAR NOT NULL,
+--     "model"     VARCHAR NOT NULL
+-- );
+--
+-- CREATE TABLE "vehicle"(
+--     "id"        INTEGER PRIMARY KEY,
+--     "bicycle"   INTEGER NULL REFERENCES "bicycle",
+--     "car"       INTEGER NULL REFERENCES "car"
+-- );
+-- @
+--
+-- The @vehicle@ table contains a nullable foreign key reference to both the bicycle and the car tables.
+--
+-- A SQL query that grabs all the vehicles from the database looks like this (note the @??@ is for the @persistent@ raw SQL query functions):
+--
+-- @
+-- SELECT ??, ??, ??
+-- FROM vehicle
+-- LEFT JOIN car
+--     ON vehicle.car = car.id
+-- LEFT JOIN bicycle
+--     ON vehicle.bicycle = bicycle.id
+-- @
+--
+-- If we use the above query with @rawSql@, we'd get the following result:
+--
+-- @
+-- getVehicles
+--     :: SqlPersistM
+--         [ ( Entity Vehicle
+--           , Maybe (Entity Bicycle)
+--           , Maybe (Entity Car)
+--           )
+--         ]
+-- @
+--
+-- This result has some post-conditions that are not guaranteed by the types *or* the schema.
+-- The constructor for @Entity Vehicle@ is going to determine which of the other members of the tuple is @Nothing@.
+-- We can convert this to a friendlier domain model like this:
+--
+-- @
+-- data Vehicle'
+--     = Car' Text Text
+--     | Bike Text
+--
+-- check = do
+--     result <- getVehicles
+--     pure (map convert result)
+--
+-- convert
+--     :: (Entity Vehicle, Maybe (Entity Bicycle), Maybe (Entity Car))
+--     -> Vehicle'
+-- convert (Entity _ (VehicleBicycleSum _), Just (Entity _ (Bicycle brand)), _) =
+--     Bike brand
+-- convert (Entity _ (VehicleCarSum _), _, Just (Entity _ (Car make model))) =
+--     Car make model
+-- convert _ =
+--     error "The database preconditions have been violated!"
+-- @
+--
+-- == Times with timezones
+--
+-- Storing times with timezones in one type in databases is not possible, although
+-- it seems that it should be possible (@timezone@ and @timezonetz@ in
+-- PostgreSQL). That's why starting with persistent 2.0, all times will be mapped
+-- to @UTCTime@. If you need to store timezone information along with times in a
+-- database, store the timezone in a second field. Here are some links about the
+-- topic with further information:
+--
+-- * https://github.com/yesodweb/persistent/issues/290
+-- * https://groups.google.com/forum/#!msg/yesodweb/MIfcV2bwM80/8QLFpgp1LykJ
+-- * http://stackoverflow.com/questions/14615271/postgres-timestamp/14616640#14616640
+-- * http://justatheory.com/computers/databases/postgresql/use-timestamptz.html
+-- * https://github.com/lpsmith/postgresql-simple/issues/69
+-- * https://github.com/nikita-volkov/hasql-postgres/issues/1
+--
+-- = Conversion table (migrations)
+--
+-- Here are the conversions between Haskell types and database types:
+--
+-- +------------+----------------------+-------------------+---------------+----------------+
+-- | Haskell    | PostgreSQL           | MySQL             | MongoDB       |  SQLite        |
+-- +============+======================+===================+===============+================+
+-- | Text       |  VARCHAR             |  TEXT             | String        |  VARCHAR       |
+-- +------------+----------------------+-------------------+---------------+----------------+
+-- | ByteString |  BYTEA               |  BLOB             | BinData       |  BLOB          |
+-- +------------+----------------------+-------------------+---------------+----------------+
+-- | Int        |  INT8                |  BIGINT(20)       | NumberLong    |  INTEGER       |
+-- +------------+----------------------+-------------------+---------------+----------------+
+-- | Double     |  DOUBLE PRECISION    |  DOUBLE           | Double        |  REAL          |
+-- +------------+----------------------+-------------------+---------------+----------------+
+-- | Rational   |  NUMERIC(22, 12)     |  DECIMAL(32,20)   | *Unsupported* |  NUMERIC(32,20)|
+-- +------------+----------------------+-------------------+---------------+----------------+
+-- | Bool       |  BOOLEAN             |  TINYINT(1)       | Boolean       |  BOOLEAN       |
+-- +------------+----------------------+-------------------+---------------+----------------+
+-- | Day        |  DATE                |  DATE             | NumberLong    |  DATE          |
+-- +------------+----------------------+-------------------+---------------+----------------+
+-- | TimeOfDay  |  TIME                |  TIME\*\*         | *Unsupported* |  TIME          |
+-- +------------+----------------------+-------------------+---------------+----------------+
+-- | UTCTime\*  |  TIMESTAMP           |  DATETIME\*\*     | Date          |  TIMESTAMP     |
+-- +------------+----------------------+-------------------+---------------+----------------+
+--
+-- Notes:
+--
+-- \* Support for @ZonedTime@ was dropped in persistent 2.0. @UTCTime@ can be used
+-- with @timestamp without timezone@ and @timestamp with timezone@ in PostgreSQL.
+-- See also the section "Times with timezones".
+--
+-- \*\* The default resolution for @TIME@ and @DATETIME@ in MySQL is one second.
+-- As of MySQL version 5.6.4, and persistent-mysql-2.6.2, fractional seconds are
+-- handled correctly if you declare an explicit precision by using @sqltype@. For
+-- example, appending @sqltype=TIME(6)@ to a @TimeOfDay@ field definition will
+-- give microsecond resolution.
+--
+-- = Compatibility tables
+--
+-- MySQL:
+--
+-- +-------------------+-----------------------------------------------------------------------+
+-- |Haskell type       | Compatible MySQL types                                                |
+-- +===================+=======================================================================+
+-- | Bool              | Tiny                                                                  |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Int8              | Tiny                                                                  |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Int16             | Tiny,Short                                                            |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Int32             | Tiny,Short,Int24,Long                                                 |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Int               | Tiny,Short,Int24,Long,LongLong\*                                      |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Int64             | Tiny,Short,Int24,Long,LongLong                                        |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Integer           | Tiny,Short,Int24,Long,LongLong                                        |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Word8             | Tiny                                                                  |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Word16            | Tiny,Short                                                            |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Word32            | Tiny,Short,Int24,Long                                                 |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Word64            | Tiny,Short,Int24,Long,LongLong                                        |
+-- | Double            | Float,Double,Decimal,NewDecimal,Tiny,Short,Int24,Long                 |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Ratio Integer     | Float,Double,Decimal,NewDecimal,Tiny,Short,Int24,Long,LongLong        |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | ByteString        | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Lazy.ByteString   | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Encoding.Text\*\* | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Lazy.Text         | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | [Char]/String     | VarChar,TinyBlob,MediumBlob,LongBlob,Blob,VarString,String,Set,Enum   |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | UTCTime           | DateTime,Timestamp                                                    |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | Day               | Year,Date,NewDate                                                     |
+-- +-------------------+-----------------------------------------------------------------------+
+-- | TimeOfDay         | Time                                                                  |
+-- +-------------------+-----------------------------------------------------------------------+
+--
+-- \* When @Word@ size is 64bit
+--
+-- \*\* Utf8 only
+--
+-- Unsupported types:
+--
+-- +--------------------------------------------------------------------+
+-- | Not currently supported                                            |
+-- +====================================================================+
+-- | Word                                                               |
+-- +--------------------------------------------------------------------+
+-- | Float                                                              |
+-- +--------------------------------------------------------------------+
+-- | Scientific <https://github.com/yesodweb/persistent/issues/225 #225>|
+-- +--------------------------------------------------------------------+
+--
+-- See <http://hackage.haskell.org/package/mysql-simple/docs/Database-MySQL-Simple-Result.html MySQL.Simple.Result>.
+module Database.Persist.Quasi
+    ( parse
+
+      -- * 'PersistSettings'
+    , PersistSettings
+    , upperCaseSettings
+    , lowerCaseSettings
+
+      -- ** Getters and Setters
+    , getPsToDBName
+    , setPsToDBName
+    , setPsToFKName
+    , setPsUseSnakeCaseForeignKeys
+    , setPsUseSnakeCaseForiegnKeys
+    , getPsStrictFields
+    , setPsStrictFields
+    , getPsIdName
+    , setPsIdName
+    , getPsTabErrorLevel
+    , setPsTabErrorLevel
+    , getPsQuotedArgumentErrorLevel
+    , setPsQuotedArgumentErrorLevel
+    ) where
+
+import Database.Persist.Quasi.Internal
+import Database.Persist.Quasi.PersistSettings
diff --git a/Database/Persist/Quasi/Internal.hs b/Database/Persist/Quasi/Internal.hs
--- a/Database/Persist/Quasi/Internal.hs
+++ b/Database/Persist/Quasi/Internal.hs
@@ -16,7 +16,7 @@
     , PersistSettings (..)
     , upperCaseSettings
     , lowerCaseSettings
-    , Token (..)
+    , Attribute (..)
     , SourceLoc (..)
     , sourceLocFromTHLoc
     , parseFieldType
@@ -61,13 +61,14 @@
 import Data.Text (Text)
 import qualified Data.Text as T
 import Database.Persist.EntityDef.Internal
-import Database.Persist.Quasi.PersistSettings
-import Database.Persist.Quasi.PersistSettings.Internal ( psToFKName
-                                                       , psToDBName
-                                                       , psIdName
-                                                       , psStrictFields
-                                                       )
 import Database.Persist.Quasi.Internal.ModelParser
+import Database.Persist.Quasi.PersistSettings
+import Database.Persist.Quasi.PersistSettings.Internal
+    ( psIdName
+    , psStrictFields
+    , psToDBName
+    , psToFKName
+    )
 import Database.Persist.Types
 import Database.Persist.Types.Base
 import Language.Haskell.TH.Syntax (Lift, Loc (..))
@@ -185,14 +186,14 @@
 
 -- | Parses a quasi-quoted syntax into a list of entity definitions.
 parse
-  :: PersistSettings
-  -> [(Maybe SourceLoc, Text)]
-  -> CumulativeParseResult [UnboundEntityDef]
+    :: PersistSettings
+    -> [(Maybe SourceLoc, Text)]
+    -> CumulativeParseResult [UnboundEntityDef]
 parse ps chunks = toCumulativeParseResult $ map parseChunk chunks
   where
     parseChunk :: (Maybe SourceLoc, Text) -> ParseResult [UnboundEntityDef]
     parseChunk (mSourceLoc, source) =
-      (fmap . fmap) (mkUnboundEntityDef ps) <$> parseSource ps mSourceLoc source
+        (fmap . fmap) (mkUnboundEntityDef ps) <$> parseSource ps mSourceLoc source
 
 entityNamesFromParsedDef
     :: PersistSettings -> ParsedEntityDef -> (EntityNameHS, EntityNameDB)
@@ -206,7 +207,7 @@
             getDbName
                 ps
                 (unEntityNameHS entNameHS)
-                (parsedEntityDefEntityAttributes parsedEntDef)
+                (attributeContent <$> parsedEntityDefEntityAttributes parsedEntDef)
 
 -- | This type represents an @Id@ declaration in the QuasiQuoted syntax.
 --
@@ -527,12 +528,11 @@
                     EntityIdField $
                         maybe autoIdField (unboundIdDefToFieldDef (defaultIdName ps) entNameHS) idField
                 , entityAttrs =
-                    parsedEntityDefEntityAttributes parsedEntDef
-                , entityFields =
-                    []
+                    attributeContent <$> parsedEntityDefEntityAttributes parsedEntDef
+                , entityFields = []
                 , entityUniques = entityConstraintDefsUniquesList entityConstraintDefs
                 , entityForeigns = []
-                , entityDerives = concat $ mapMaybe takeDerives textAttribs
+                , entityDerives = concat $ mapMaybe takeDerives (textFields ++ textDirectives)
                 , entityExtra = parsedEntityDefExtras parsedEntDef
                 , entitySum = parsedEntityDefIsSum parsedEntDef
                 , entityComments =
@@ -546,19 +546,22 @@
     (entNameHS, entNameDB) =
         entityNamesFromParsedDef ps parsedEntDef
 
-    attribs =
-        parsedEntityDefFieldAttributes parsedEntDef
+    fields = parsedEntityDefFields parsedEntDef
+    directives = parsedEntityDefDirectives parsedEntDef
 
     cols :: [UnboundFieldDef]
-    cols = foldMap (toList . commentedField ps) attribs
+    cols = foldMap (toList . commentedField ps) fields
 
-    textAttribs :: [[Text]]
-    textAttribs = fmap tokenContent . fst <$> attribs
+    textFields :: [[Text]]
+    textFields = entityFieldContent . fst <$> fields
 
+    textDirectives :: [[Text]]
+    textDirectives = directiveContent . fst <$> directives
+
     entityConstraintDefs =
         foldMap
             (maybe mempty (takeConstraint ps entNameHS cols) . NEL.nonEmpty)
-            textAttribs
+            (textFields ++ textDirectives)
 
     idField =
         case entityConstraintDefsIdField entityConstraintDefs of
@@ -574,10 +577,10 @@
 
     commentedField
         :: PersistSettings
-        -> ([Token], Maybe Text)
+        -> (EntityField, Maybe Text)
         -> Maybe UnboundFieldDef
-    commentedField s (tokens, mCommentText) = do
-        unb <- takeColsEx s (tokenContent <$> tokens)
+    commentedField s (field, mCommentText) = do
+        unb <- takeColsEx s (entityFieldContent field)
         pure $ unb{unboundFieldComments = mCommentText}
 
     autoIdField :: FieldDef
diff --git a/Database/Persist/Quasi/Internal/ModelParser.hs b/Database/Persist/Quasi/Internal/ModelParser.hs
--- a/Database/Persist/Quasi/Internal/ModelParser.hs
+++ b/Database/Persist/Quasi/Internal/ModelParser.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE FlexibleInstances #-}
@@ -5,23 +6,22 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TupleSections #-}
-{-# LANGUAGE CPP #-}
 
 module Database.Persist.Quasi.Internal.ModelParser
     ( SourceLoc (..)
-    , Token (..)
-    , tokenContent
-    , anyToken
-    , ParsedEntityDef
-    , parsedEntityDefComments
-    , parsedEntityDefEntityName
-    , parsedEntityDefIsSum
-    , parsedEntityDefEntityAttributes
-    , parsedEntityDefFieldAttributes
-    , parsedEntityDefExtras
-    , parsedEntityDefSpan
+    , Attribute (..)
+    , attribute
+    , attributeContent
+    , Directive (..)
+    , directiveContent
+    , EntityField (..)
+    , entityField
+    , entityFieldContent
+    , FieldName (..)
+    , fieldName
+    , ParsedEntityDef (..)
     , parseSource
-    , memberBlockAttrs
+    , memberEntityFields
     , ParserWarning
     , parserWarningMessage
     , ParseResult
@@ -34,7 +34,7 @@
     ) where
 
 import Control.Applicative (Alternative)
-import Control.Monad (MonadPlus, mzero, void)
+import Control.Monad (MonadPlus, void)
 import Control.Monad.Reader (MonadReader, ReaderT, asks, runReaderT)
 import Control.Monad.State
 import Control.Monad.Writer
@@ -42,7 +42,7 @@
 import Data.Either (partitionEithers)
 import Data.Foldable (fold)
 import Data.Functor.Identity
-import Data.List (find, intercalate)
+import Data.List (intercalate)
 import Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NEL
 import qualified Data.Map as M
@@ -52,11 +52,12 @@
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Void
+import Database.Persist.Quasi.Internal.TypeParser
 import Database.Persist.Quasi.PersistSettings.Internal
 import Database.Persist.Types
 import Database.Persist.Types.SourceSpan
 import Language.Haskell.TH.Syntax (Lift)
-import Text.Megaparsec hiding (Token)
+import Text.Megaparsec
 import Text.Megaparsec.Char
 import qualified Text.Megaparsec.Char.Lexer as L
 import qualified Text.Megaparsec.Stream as TMS
@@ -101,6 +102,7 @@
         , MonadState ExtraState
         , MonadReader PersistSettings
         , MonadParsec Void String
+        , MonadFail
         )
 
 type EntityParseError = ParseErrorBundle String Void
@@ -211,19 +213,18 @@
             else parseError err
 
 -- | Attempts to parse with a provided parser. If it fails with an error matching
--- the provided predicate, it registers a delayed error with the provided message and falls
+-- the provided predicate, it registers a delayed error and falls
 -- back to the second provided parser.
 --
 -- This is useful when registering errors in space consumers and other parsers that are called
 -- with `try`, since a non-delayed error in this context will cause backtracking and not
 -- get reported to the user.
 tryOrRegisterError
-    :: String
-    -> (ParseError String Void -> Bool)
+    :: (ParseError String Void -> Bool)
     -> Parser a
     -> Parser a
     -> Parser a
-tryOrRegisterError msg p l r = do
+tryOrRegisterError p l r = do
     parserState <- getParserState
     withRecovery (delayedError $ statePosState parserState) l
   where
@@ -244,7 +245,7 @@
     -> Parser a
     -> Parser a
 tryOrReport level msg p l r = case level of
-    Just LevelError -> tryOrRegisterError msg p l r
+    Just LevelError -> tryOrRegisterError p l r
     Just LevelWarning -> tryOrWarn msg p l r
     Nothing -> r
 
@@ -258,37 +259,113 @@
     }
     deriving (Show, Lift)
 
--- @since 2.16.0.0
-data Token
-    = Quotation Text
-    | Equality Text Text
+-- | An attribute of an entity field definition or a directive.
+--
+-- @since 2.17.1.0
+data Attribute
+    = Assignment Text Text
     | Parenthetical Text
-    | BlockKey Text
     | PText Text
+    | -- | Quoted field attributes are deprecated since 2.17.1.0.
+      Quotation Text
     deriving (Eq, Ord, Show)
 
+-- | The name of an entity block or extra block.
+--
+-- @since 2.17.1.0
+newtype BlockKey = BlockKey Text
+    deriving (Show)
+
+-- | A parsed comment or doc comment.
+--
 -- @since 2.16.0.0
 data CommentToken
     = DocComment Text
     | Comment Text
     deriving (Eq, Ord, Show)
 
--- | Converts a token into a Text representation for second-stage parsing or presentation to the user
+-- | Converts an attribute into a Text representation for second-stage parsing or
+-- presentation to the user
 --
 -- @since 2.16.0.0
-tokenContent :: Token -> Text
-tokenContent = \case
-    Quotation s -> s
-    Equality l r -> mconcat [l, "=", r]
+attributeContent :: Attribute -> Text
+attributeContent = \case
+    Assignment l r -> mconcat [l, "=", r]
     Parenthetical s -> s
     PText s -> s
-    BlockKey s -> s
+    Quotation s -> s
 
+-- | Converts a directive into a Text representation for second-stage parsing or
+-- presentation to the user
+--
+-- @since 2.17.1.0
+directiveContent :: Directive -> [Text]
+directiveContent d =
+    [directiveNameContent $ directiveName d]
+        <> (attributeContent <$> directiveAttributes d)
+
+entityFieldContent :: EntityField -> [Text]
+entityFieldContent f =
+    [ fieldNameAndStrictnessAsText f
+    , (typeExprContent . entityFieldType) f
+    ]
+        ++ fmap attributeContent (entityFieldAttributes f)
+
+blockKeyContent :: BlockKey -> Text
+blockKeyContent (BlockKey t) = t
+
+directiveNameContent :: DirectiveName -> Text
+directiveNameContent (DirectiveName t) = t
+
+-- | Generates the field name of an EntityField, accompanied by
+-- its strictness sigil, if one is present.
+-- This is only needed temporarily, and can eventually be refactored away.
+--
+-- @since 2.17.1.0
+fieldNameAndStrictnessAsText :: EntityField -> Text
+fieldNameAndStrictnessAsText f =
+    let
+        s = case entityFieldStrictness f of
+            Just Strict -> "!"
+            Just Lazy -> "~"
+            Nothing -> ""
+        (FieldName fn) = entityFieldName f
+     in
+        s <> fn
+
 commentContent :: CommentToken -> Text
 commentContent = \case
     Comment s -> s
     DocComment s -> s
 
+quotedAttributeErrorMessage :: String
+quotedAttributeErrorMessage = "Unexpected quotation mark in field or directive attribute"
+
+attribute :: Parser Attribute
+attribute = do
+    quotedFieldAttributeErrorLevel <- asks psQuotedArgumentErrorLevel
+    tryOrReport
+        quotedFieldAttributeErrorLevel
+        "Quoted field attributes are deprecated since 2.17.1.0, and will be removed in or after 2.18.0.0"
+        isQuotedAttributeError
+        attribute'
+        (Quotation . Text.pack <$> quotation)
+  where
+    isQuotedAttributeError (FancyError _ s) = s == Set.singleton (ErrorFail quotedAttributeErrorMessage)
+    isQuotedAttributeError _ = False
+
+attribute' :: Parser Attribute
+attribute' = do
+    q <- lookAhead (optional $ char '"')
+    case q of
+        Just _ -> fail quotedAttributeErrorMessage
+        Nothing ->
+            choice
+                [ try assignment
+                , parenthetical
+                , ptext
+                ]
+
 docComment :: Parser (SourcePos, CommentToken)
 docComment = do
     pos <- getSourcePos
@@ -365,6 +442,9 @@
         skipComment
         empty
 
+-- This catch-all character class is used in a variety of places, and includes characters
+-- which have syntactic function. As we continue to iterate on the parser, we may want to consider
+-- shrinking or eliminating `contentChar`.
 contentChar :: Parser Char
 contentChar =
     choice
@@ -408,23 +488,28 @@
                 _ -> unexpected (Tokens $ char2 :| [])
         _ -> pure char1
 
-equality :: Parser Token
-equality = label "equality expression" $ do
+assignment :: Parser Attribute
+assignment = label "assignment expression" $ do
     L.lexeme spaceConsumer $ do
         lhs <- some contentChar
         _ <- char '='
         rhs <-
             choice
-                [ quotation'
+                [ quotation
                 , sqlLiteral
                 , parentheticalInner
+                , try sqlFunctionApplication
                 , some $ contentChar <|> char '(' <|> char ')'
                 ]
-        pure $ Equality (Text.pack lhs) (Text.pack rhs)
+        pure $ Assignment (Text.pack lhs) (Text.pack rhs)
   where
     parentheticalInner = do
         str <- parenthetical'
         pure . init . drop 1 $ str
+    sqlFunctionApplication = do
+        fn <- some contentChar
+        argString <- parentheticalInner
+        pure $ mconcat [fn, "(", argString, ")"]
 
 sqlTypeName :: Parser String
 sqlTypeName =
@@ -449,15 +534,10 @@
             , fromMaybe "" st
             ]
 
-quotation :: Parser Token
-quotation = label "quotation" $ do
-    str <- L.lexeme spaceConsumer quotation'
-    pure . Quotation $ Text.pack str
-
-quotation' :: Parser String
-quotation' = char '"' *> manyTill charLiteral (char '"')
+quotation :: Parser String
+quotation = char '"' *> manyTill charLiteral (char '"')
 
-parenthetical :: Parser Token
+parenthetical :: Parser Attribute
 parenthetical = label "parenthetical" $ do
     str <- L.lexeme spaceConsumer parenthetical'
     pure . Parenthetical . Text.pack . init . drop 1 $ str
@@ -470,33 +550,41 @@
     q = mconcat <$> some (c <|> parenthetical')
     c = (: []) <$> choice [contentChar, nonLineSpaceChar, char '"']
 
-blockKey :: Parser Token
+blockKey :: Parser BlockKey
 blockKey = label "block key" $ do
     fl <- upperChar
     rl <- many alphaNumChar
     pure . BlockKey . Text.pack $ fl : rl
 
-ptext :: Parser Token
-ptext = label "plain token" $ do
+fieldStrictness :: Parser FieldStrictness
+fieldStrictness =
+    label "strictness sigil" $
+        (Strict <$ char '!') <|> (Lazy <$ char '~')
+
+fieldName :: Parser FieldName
+fieldName = label "field name" $ do
+    fl <- lowerChar
+    rl <- many fieldNameChar
+    pure . FieldName . Text.pack $ fl : rl
+  where
+    fieldNameChar =
+        choice
+            [ alphaNumChar
+            , char '_'
+            ]
+
+ptext :: Parser Attribute
+ptext = label "plain attribute" $ do
     str <- L.lexeme spaceConsumer $ some contentChar
     pure . PText . Text.pack $ str
 
--- @since 2.16.0.0
-anyToken :: Parser Token
-anyToken =
-    choice
-        [ try equality
-        , quotation
-        , parenthetical
-        , ptext
-        ]
-
 data ParsedEntityDef = ParsedEntityDef
     { parsedEntityDefComments :: [Text]
     , parsedEntityDefEntityName :: EntityNameHS
     , parsedEntityDefIsSum :: Bool
-    , parsedEntityDefEntityAttributes :: [Attr]
-    , parsedEntityDefFieldAttributes :: [([Token], Maybe Text)]
+    , parsedEntityDefEntityAttributes :: [Attribute]
+    , parsedEntityDefFields :: [(EntityField, Maybe Text)]
+    , parsedEntityDefDirectives :: [(Directive, Maybe Text)]
     , parsedEntityDefExtras :: M.Map Text [ExtraLine]
     , parsedEntityDefSpan :: Maybe SourceSpan
     }
@@ -511,7 +599,7 @@
 data EntityHeader = EntityHeader
     { entityHeaderSum :: Bool
     , entityHeaderTableName :: Text
-    , entityHeaderRemainingTokens :: [Token]
+    , entityHeaderRemainingAttributes :: [Attribute]
     , entityHeaderPos :: SourcePos
     }
     deriving (Show)
@@ -531,23 +619,33 @@
     [] -> entityBlockFirstPos eb
     members -> maximum $ fmap memberEndPos members
 
-entityBlockBlockAttrs :: EntityBlock -> [BlockAttr]
-entityBlockBlockAttrs = foldMap f <$> entityBlockMembers
+entityBlockEntityFields :: EntityBlock -> [EntityField]
+entityBlockEntityFields = foldMap f <$> entityBlockMembers
   where
     f m = case m of
         MemberExtraBlock _ -> []
-        MemberBlockAttr ba -> [ba]
+        MemberEntityField ba -> [ba]
+        MemberDirective _ -> []
 
 entityBlockExtraBlocks :: EntityBlock -> [ExtraBlock]
 entityBlockExtraBlocks = foldMap f <$> entityBlockMembers
   where
     f m = case m of
         MemberExtraBlock eb -> [eb]
-        MemberBlockAttr _ -> []
+        MemberEntityField _ -> []
+        MemberDirective _ -> []
 
+entityBlockDirectives :: EntityBlock -> [Directive]
+entityBlockDirectives = foldMap f <$> entityBlockMembers
+  where
+    f m = case m of
+        MemberExtraBlock _ -> []
+        MemberEntityField _ -> []
+        MemberDirective bd -> [bd]
+
 data ExtraBlockHeader = ExtraBlockHeader
     { extraBlockHeaderKey :: Text
-    , extraBlockHeaderRemainingTokens :: [Token]
+    , extraBlockHeaderRemainingAttributes :: [Attribute]
     , extraBlockHeaderPos :: SourcePos
     }
     deriving (Show)
@@ -555,53 +653,86 @@
 data ExtraBlock = ExtraBlock
     { extraBlockDocCommentBlock :: Maybe DocCommentBlock
     , extraBlockExtraBlockHeader :: ExtraBlockHeader
-    , extraBlockMembers :: NonEmpty Member
+    , extraBlockLines :: NonEmpty ExtraBlockLine
     }
     deriving (Show)
 
-data BlockAttr = BlockAttr
-    { blockAttrDocCommentBlock :: Maybe DocCommentBlock
-    , blockAttrTokens :: [Token]
-    , blockAttrPos :: SourcePos
+data FieldStrictness = Strict | Lazy
+    deriving (Show)
+
+newtype FieldName = FieldName Text
+    deriving (Show, Eq)
+
+newtype DirectiveName = DirectiveName Text
+    deriving (Show, Eq)
+
+data EntityField = EntityField
+    { entityFieldDocCommentBlock :: Maybe DocCommentBlock
+    , entityFieldStrictness :: Maybe FieldStrictness
+    , entityFieldName :: FieldName
+    , entityFieldType :: TypeExpr
+    , entityFieldAttributes :: [Attribute]
+    , entityFieldPos :: SourcePos
     }
     deriving (Show)
 
-data Member = MemberExtraBlock ExtraBlock | MemberBlockAttr BlockAttr
+data Directive = Directive
+    { directiveDocCommentBlock :: Maybe DocCommentBlock
+    , directiveName :: DirectiveName
+    , directiveAttributes :: [Attribute]
+    , directivePos :: SourcePos
+    }
     deriving (Show)
 
+data Member
+    = MemberExtraBlock ExtraBlock
+    | MemberEntityField EntityField
+    | MemberDirective Directive
+    deriving (Show)
+
+data ExtraBlockLine = ExtraBlockLine
+    { extraBlockLineDocCommentBlock :: Maybe DocCommentBlock
+    , extraBlockLineTokens :: [String]
+    , extraBlockLinePos :: SourcePos
+    }
+    deriving (Show)
+
 -- | The source position at the beginning of the member's final line.
 memberEndPos :: Member -> SourcePos
-memberEndPos (MemberBlockAttr fs) = blockAttrPos fs
-memberEndPos (MemberExtraBlock ex) = memberEndPos . NEL.last . extraBlockMembers $ ex
+memberEndPos (MemberEntityField fs) = entityFieldPos fs
+memberEndPos (MemberDirective d) = directivePos d
+memberEndPos (MemberExtraBlock ex) = extraBlockLinePos . NEL.last . extraBlockLines $ ex
 
--- | Represents an entity member as a list of BlockAttrs
+-- | Represents an entity member as a list of EntityFields
 --
 -- @since 2.16.0.0
-memberBlockAttrs :: Member -> [BlockAttr]
-memberBlockAttrs (MemberBlockAttr fs) = [fs]
-memberBlockAttrs (MemberExtraBlock ex) = foldMap memberBlockAttrs . extraBlockMembers $ ex
+memberEntityFields :: Member -> [EntityField]
+memberEntityFields (MemberEntityField fs) = [fs]
+memberEntityFields (MemberDirective _) = []
+memberEntityFields (MemberExtraBlock _) = []
 
 extraBlocksAsMap :: [ExtraBlock] -> M.Map Text [ExtraLine]
 extraBlocksAsMap exs = M.fromList $ fmap asPair exs
   where
     asPair ex =
-        (extraBlockHeaderKey . extraBlockExtraBlockHeader $ ex, extraLines ex)
-    extraLines ex = foldMap asExtraLine (extraBlockMembers ex)
-    asExtraLine (MemberBlockAttr fs) = [tokenContent <$> blockAttrTokens fs]
-    asExtraLine _ = []
+        ( extraBlockHeaderKey . extraBlockExtraBlockHeader $ ex
+        , NEL.toList (extraLines ex)
+        )
+    extraLines :: ExtraBlock -> NonEmpty [Text]
+    extraLines ex = fmap Text.pack . extraBlockLineTokens <$> extraBlockLines ex
 
 entityHeader :: Parser EntityHeader
 entityHeader = do
     pos <- getSourcePos
     plus <- optional (char '+')
     en <- validHSpace *> L.lexeme spaceConsumer blockKey
-    rest <- L.lexeme spaceConsumer (many anyToken)
+    rest <- L.lexeme spaceConsumer (many attribute)
     _ <- setLastDocumentablePosition
     pure
         EntityHeader
             { entityHeaderSum = isJust plus
-            , entityHeaderTableName = tokenContent en
-            , entityHeaderRemainingTokens = rest
+            , entityHeaderTableName = blockKeyContent en
+            , entityHeaderRemainingAttributes = rest
             , entityHeaderPos = pos
             }
 
@@ -627,7 +758,7 @@
     let
         candidates = dropWhile (\(_sp, ct) -> not (isDocComment ct)) comments
         filteredCandidates = dropWhile (commentIsIncorrectlyPositioned es) candidates
-    pure $ docCommentBlockFromPositionedTokens filteredCandidates
+    pure $ docCommentBlockFromPositionedAttributes filteredCandidates
   where
     commentIsIncorrectlyPositioned
         :: ExtraState -> (SourcePos, CommentToken) -> Bool
@@ -638,51 +769,110 @@
 extraBlock :: Parser Member
 extraBlock = L.indentBlock spaceConsumerN innerParser
   where
-    mkExtraBlockMember dcb (header, blockAttrs) =
+    mkExtraBlockMember dcb (header, extraBlockLines) =
         MemberExtraBlock
             ExtraBlock
                 { extraBlockExtraBlockHeader = header
-                , extraBlockMembers = ensureNonEmpty blockAttrs
+                , extraBlockLines = ensureNonEmpty extraBlockLines
                 , extraBlockDocCommentBlock = dcb
                 }
-    ensureNonEmpty members = case NEL.nonEmpty members of
+    ensureNonEmpty lines = case NEL.nonEmpty lines of
         Just nel -> nel
-        Nothing -> error "unreachable" -- members is known to be non-empty
+        Nothing -> error "unreachable" -- lines is known to be non-empty
     innerParser = do
         dcb <- getDcb
         header <- extraBlockHeader
         pure $
-            L.IndentSome Nothing (return . mkExtraBlockMember dcb . (header,)) blockAttr
+            L.IndentSome
+                Nothing
+                (return . mkExtraBlockMember dcb . (header,))
+                extraBlockLine
 
 extraBlockHeader :: Parser ExtraBlockHeader
 extraBlockHeader = do
     pos <- getSourcePos
     tn <- L.lexeme spaceConsumer blockKey
-    rest <- L.lexeme spaceConsumer (many anyToken)
+    rest <- L.lexeme spaceConsumer (many attribute)
     _ <- setLastDocumentablePosition
     pure $
         ExtraBlockHeader
-            { extraBlockHeaderKey = tokenContent tn
-            , extraBlockHeaderRemainingTokens = rest
+            { extraBlockHeaderKey = blockKeyContent tn
+            , extraBlockHeaderRemainingAttributes = rest
             , extraBlockHeaderPos = pos
             }
 
-blockAttr :: Parser Member
-blockAttr = do
+extraBlockLine :: Parser ExtraBlockLine
+extraBlockLine = do
     dcb <- getDcb
     pos <- getSourcePos
-    line <- some anyToken
+    tokens <- some $ L.lexeme spaceConsumer (some contentChar)
     _ <- setLastDocumentablePosition
     pure $
-        MemberBlockAttr
-            BlockAttr
-                { blockAttrDocCommentBlock = dcb
-                , blockAttrTokens = line
-                , blockAttrPos = pos
+        ExtraBlockLine
+            { extraBlockLineDocCommentBlock = dcb
+            , extraBlockLineTokens = tokens
+            , extraBlockLinePos = pos
+            }
+
+entityField :: Parser Member
+entityField = do
+    dcb <- getDcb
+    pos <- getSourcePos
+    ss <- optional fieldStrictness
+    fn <- L.lexeme spaceConsumer fieldName
+    ft <- L.lexeme spaceConsumer typeExpr -- Note that `typeExpr` consumes outer parentheses.
+    fa <- L.lexeme spaceConsumer (many attribute)
+    _ <- setLastDocumentablePosition
+    lookAhead (void newline <|> eof)
+    pure $
+        MemberEntityField
+            EntityField
+                { entityFieldDocCommentBlock = dcb
+                , entityFieldStrictness = ss
+                , entityFieldName = fn
+                , entityFieldType = ft
+                , entityFieldAttributes = fa
+                , entityFieldPos = pos
                 }
 
+directiveNameP :: Parser DirectiveName
+directiveNameP =
+    label "directive name" $
+        DirectiveName . Text.pack
+            <$> choice
+                [ string "deriving"
+                , directiveName'
+                ]
+  where
+    directiveName' = do
+        fl <- upperChar
+        rl <- many alphaNumChar
+        pure (fl : rl)
+
+directive :: Parser Member
+directive = do
+    dcb <- getDcb
+    pos <- getSourcePos
+    dn <- L.lexeme spaceConsumer directiveNameP
+    args <- many $ L.lexeme spaceConsumer attribute
+    _ <- setLastDocumentablePosition
+    lookAhead (void newline <|> eof)
+    pure $
+        MemberDirective
+            Directive
+                { directiveDocCommentBlock = dcb
+                , directiveName = dn
+                , directiveAttributes = args
+                , directivePos = pos
+                }
+
 member :: Parser Member
-member = try extraBlock <|> blockAttr
+member =
+    choice
+        [ try extraBlock
+        , directive
+        , entityField
+        ]
 
 entityBlock :: Parser EntityBlock
 entityBlock = do
@@ -710,9 +900,9 @@
     DocComment _ -> True
     _ -> False
 
-docCommentBlockFromPositionedTokens
+docCommentBlockFromPositionedAttributes
     :: [(SourcePos, CommentToken)] -> Maybe DocCommentBlock
-docCommentBlockFromPositionedTokens ptoks =
+docCommentBlockFromPositionedAttributes ptoks =
     case NEL.nonEmpty ptoks of
         Nothing -> Nothing
         Just nel ->
@@ -744,7 +934,8 @@
         , parsedEntityDefEntityName = entityNameHS
         , parsedEntityDefIsSum = isSum
         , parsedEntityDefEntityAttributes = entityAttributes
-        , parsedEntityDefFieldAttributes = parsedFieldAttributes
+        , parsedEntityDefFields = parsedFields
+        , parsedEntityDefDirectives = parsedDirectives
         , parsedEntityDefExtras = extras
         , parsedEntityDefSpan = mSpan
         }
@@ -754,13 +945,15 @@
             []
             docCommentBlockLines
             (entityBlockDocCommentBlock eb)
-    entityAttributes =
-        tokenContent <$> (entityHeaderRemainingTokens . entityBlockEntityHeader) eb
+    entityAttributes = entityHeaderRemainingAttributes . entityBlockEntityHeader $ eb
     isSum = entityHeaderSum . entityBlockEntityHeader $ eb
     entityNameHS = EntityNameHS . entityHeaderTableName . entityBlockEntityHeader $ eb
 
-    attributePair a = (blockAttrTokens a, docCommentBlockText <$> blockAttrDocCommentBlock a)
-    parsedFieldAttributes = fmap attributePair (entityBlockBlockAttrs eb)
+    fieldPair a = (a, docCommentBlockText <$> entityFieldDocCommentBlock a)
+    parsedFields = fmap fieldPair (entityBlockEntityFields eb)
+
+    directivePair d = (d, docCommentBlockText <$> directiveDocCommentBlock d)
+    parsedDirectives = fmap directivePair (entityBlockDirectives eb)
 
     extras = extraBlocksAsMap (entityBlockExtraBlocks eb)
     filepath = maybe "" locFile mSourceLoc
diff --git a/Database/Persist/Quasi/Internal/TypeParser.hs b/Database/Persist/Quasi/Internal/TypeParser.hs
new file mode 100644
--- /dev/null
+++ b/Database/Persist/Quasi/Internal/TypeParser.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Database.Persist.Quasi.Internal.TypeParser
+    ( TypeExpr (..)
+    , TypeConstructor (..)
+    , typeExpr
+    , innerTypeExpr
+    , typeExprContent
+    ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
+
+-- | A parsed type expression.
+--
+-- @since 2.17.1.0
+data TypeExpr
+    = TypeApplication TypeExpr [TypeExpr]
+    | TypeConstructorExpr TypeConstructor
+    | TypeLitString String
+    | TypeLitInt String
+    | TypeLitPromotedConstructor TypeConstructor
+    deriving (Show, Eq)
+
+-- | A parsed type constructor.
+--
+-- @since 2.17.1.0
+data TypeConstructor
+    = ListConstructor
+    | TypeConstructor String
+    deriving (Show, Eq)
+
+-- | Parses a Persistent-style type expression.
+-- Persistent's type expressions are largely similar to Haskell's, but with a few differences:
+--
+-- 1. Syntactic sugar is not currently supported for constructing types other than List.
+-- 2. Only certain typelevel literals are supported: Strings, Ints, and promoted type constructors.
+-- 3. Because they must be parsed as part of an entity field definition, top-level applications
+--    of non-nullary type constructors (except for the sugary List constructor) must
+--    be parenthesized.
+--
+--    VALID:    Int
+--    VALID:    [Maybe Int]
+--    VALID:    (Maybe Int)
+--    INVALID:  Maybe Int
+--
+-- @since 2.17.1.0
+typeExpr :: ((MonadParsec e String) m) => m TypeExpr
+typeExpr = typeExpr' Outer
+
+-- | Parses a type expression in non-top-level contexts, where an unparenthesized type constructor
+-- application is acceptable.
+--
+-- @since 2.17.1.0
+innerTypeExpr :: ((MonadParsec e String) m) => m TypeExpr
+innerTypeExpr = typeExpr' Inner
+
+data IsInner = Inner | Outer
+
+typeExpr' :: ((MonadParsec e String) m) => IsInner -> m TypeExpr
+typeExpr' isInner = label "type expression" $ do
+    let
+        validEmbeddedApplications = case isInner of
+            Inner ->
+                [ simpleTypeApplication
+                , complexTypeApplication
+                ]
+            Outer -> [nullaryTypeApplication]
+    choice $
+        validEmbeddedApplications
+            ++ [ whitespaceBetween '(' ')' innerTypeExpr
+               , listType
+               , typeLitPromotedConstructor
+               , typeLitString
+               , typeLitInt
+               ]
+  where
+    -- This is a proper subset of `simpleTypeApplication`.
+    nullaryTypeApplication :: ((MonadParsec e String) m) => m TypeExpr
+    nullaryTypeApplication = do
+        tc <- typeConstructor <* optional hspace
+        pure $ TypeApplication (TypeConstructorExpr tc) []
+
+-- This does not parse sugary constructors such as the List constructor `[]`.
+typeConstructor :: ((MonadParsec e String) m) => m TypeConstructor
+typeConstructor = do
+    first <- upperChar
+    rest <- many $ choice [alphaNumChar, char '.', char '\'']
+    pure $ TypeConstructor (first : rest)
+
+whitespaceBetween :: ((MonadParsec e String) m) => Char -> Char -> m a -> m a
+whitespaceBetween ldelim rdelim =
+    between (char ldelim *> optional hspace) (optional hspace *> char rdelim)
+
+complexTypeApplication :: ((MonadParsec e String) m) => m TypeExpr
+complexTypeApplication = do
+    t <- whitespaceBetween '(' ')' innerTypeExpr <* hspace
+    args <- some (typeExpr <* optional hspace)
+    pure $ TypeApplication t args
+
+simpleTypeApplication :: ((MonadParsec e String) m) => m TypeExpr
+simpleTypeApplication = do
+    tc <- typeConstructor <* optional hspace
+    args <- many (typeExpr <* optional hspace)
+    pure $ TypeApplication (TypeConstructorExpr tc) args
+
+typeLitString :: ((MonadParsec e String) m) => m TypeExpr
+typeLitString = do
+    s <- char '"' *> manyTill L.charLiteral (char '"')
+    pure $ TypeLitString s
+
+typeLitInt :: ((MonadParsec e String) m) => m TypeExpr
+typeLitInt = TypeLitInt <$> some digitChar
+
+typeLitPromotedConstructor :: ((MonadParsec e String) m) => m TypeExpr
+typeLitPromotedConstructor = do
+    _ <- char '\'' <* optional hspace
+    TypeLitPromotedConstructor <$> typeConstructor
+
+listType :: ((MonadParsec e String) m) => m TypeExpr
+listType = do
+    t <- whitespaceBetween '[' ']' innerTypeExpr
+    pure $ TypeApplication (TypeConstructorExpr ListConstructor) [t]
+
+-- | Given a TypeExpr, renders it back to a String in a canonical form that looks
+-- normal to humans and is re-parseable when making an UnboundEntityDef that uses it.
+--
+-- @since 2.17.1.0
+typeExprContent :: TypeExpr -> Text
+typeExprContent = typeExprContent' Outer
+
+-- This is a little gnarly-looking. That's mostly due to attempting to avoid inserting
+-- superfluous parentheses.
+typeExprContent' :: IsInner -> TypeExpr -> Text
+typeExprContent' isInner = \case
+    TypeLitString s ->
+        mconcat
+            [ "\""
+            , T.pack s
+            , "\""
+            ]
+    TypeLitInt s -> T.pack s
+    TypeLitPromotedConstructor tc -> "'" <> typeExprContent' isInner (TypeConstructorExpr tc)
+    TypeConstructorExpr (TypeConstructor s) -> T.pack s
+    TypeConstructorExpr ListConstructor -> "List"
+    TypeApplication (TypeConstructorExpr tc) args -> simpleTypeApplicationContent tc args isInner
+    TypeApplication t exps ->
+        mconcat
+            [ typeExprContent' Inner t
+            , " "
+            , T.intercalate " " $ fmap typeExprContent exps
+            ]
+  where
+    typeArgsListContent :: IsInner -> [TypeExpr] -> Text
+    typeArgsListContent i exps = T.intercalate " " $ fmap (typeExprContent' i) exps
+
+    simpleTypeApplicationContent :: TypeConstructor -> [TypeExpr] -> IsInner -> Text
+    simpleTypeApplicationContent ListConstructor args _ =
+        mconcat
+            [ "["
+            , typeArgsListContent Outer args
+            , "]"
+            ]
+    simpleTypeApplicationContent (TypeConstructor s) [] _ = T.pack s
+    simpleTypeApplicationContent (TypeConstructor s) exps Inner =
+        mconcat
+            [ "("
+            , simpleTypeApplicationContent (TypeConstructor s) exps Outer
+            , ")"
+            ]
+    simpleTypeApplicationContent (TypeConstructor s) exps Outer =
+        mconcat
+            [ T.pack s
+            , " "
+            , typeArgsListContent Inner exps
+            ]
diff --git a/Database/Persist/Quasi/PersistSettings.hs b/Database/Persist/Quasi/PersistSettings.hs
--- a/Database/Persist/Quasi/PersistSettings.hs
+++ b/Database/Persist/Quasi/PersistSettings.hs
@@ -20,6 +20,8 @@
     , setPsIdName
     , getPsTabErrorLevel
     , setPsTabErrorLevel
+    , getPsQuotedArgumentErrorLevel
+    , setPsQuotedArgumentErrorLevel
     ) where
 
 import Database.Persist.Quasi.PersistSettings.Internal
diff --git a/Database/Persist/Quasi/PersistSettings/Internal.hs b/Database/Persist/Quasi/PersistSettings/Internal.hs
--- a/Database/Persist/Quasi/PersistSettings/Internal.hs
+++ b/Database/Persist/Quasi/PersistSettings/Internal.hs
@@ -38,6 +38,11 @@
     -- ^ Whether and with what severity to disallow tabs in entity source text.
     --
     -- @since 2.16.0.0
+    , psQuotedArgumentErrorLevel :: Maybe ParserErrorLevel
+    -- ^ Whether and with what severity to disallow quoted entity field attributes
+    -- and quoted directive arguments.
+    --
+    -- @since 2.17.1.0
     }
 
 defaultPersistSettings, upperCaseSettings, lowerCaseSettings :: PersistSettings
@@ -48,6 +53,7 @@
         , psStrictFields = True
         , psIdName = "id"
         , psTabErrorLevel = Just LevelWarning
+        , psQuotedArgumentErrorLevel = Just LevelWarning
         }
 upperCaseSettings = defaultPersistSettings
 lowerCaseSettings =
@@ -181,3 +187,22 @@
 setPsTabErrorLevel
     :: Maybe ParserErrorLevel -> PersistSettings -> PersistSettings
 setPsTabErrorLevel l ps = ps{psTabErrorLevel = l}
+
+-- | Retrieve the severity of the error generated when the parser encounters a
+-- quoted entity field attribute or quoted directive argument.
+-- If it is @Nothing@, quoted arguments are permitted in both entity field
+-- definitions and directives.
+--
+-- @since 2.17.1.0
+getPsQuotedArgumentErrorLevel :: PersistSettings -> Maybe ParserErrorLevel
+getPsQuotedArgumentErrorLevel = psQuotedArgumentErrorLevel
+
+-- | Set the severity of the error generated when the parser encounters a
+-- quoted entity field attribute.
+-- If set to @Nothing@, quoted arguments are permitted in both entity field
+-- definitions and directives.
+--
+-- @since 2.17.1.0
+setPsQuotedArgumentErrorLevel
+    :: Maybe ParserErrorLevel -> PersistSettings -> PersistSettings
+setPsQuotedArgumentErrorLevel l ps = ps{psQuotedArgumentErrorLevel = l}
diff --git a/persistent.cabal b/persistent.cabal
--- a/persistent.cabal
+++ b/persistent.cabal
@@ -1,5 +1,5 @@
 name:               persistent
-version:            2.17.0.0
+version:            2.17.1.0
 license:            MIT
 license-file:       LICENSE
 author:             Michael Snoyman <michael@snoyman.com>
@@ -81,10 +81,11 @@
     Database.Persist.Names
     Database.Persist.PersistValue
     Database.Persist.Quasi
-    Database.Persist.Quasi.PersistSettings
-    Database.Persist.Quasi.PersistSettings.Internal
     Database.Persist.Quasi.Internal
     Database.Persist.Quasi.Internal.ModelParser
+    Database.Persist.Quasi.Internal.TypeParser
+    Database.Persist.Quasi.PersistSettings
+    Database.Persist.Quasi.PersistSettings.Internal
     Database.Persist.Sql
     Database.Persist.Sql.Migration
     Database.Persist.Sql.Types.Internal
diff --git a/test/Database/Persist/QuasiSpec.hs b/test/Database/Persist/QuasiSpec.hs
--- a/test/Database/Persist/QuasiSpec.hs
+++ b/test/Database/Persist/QuasiSpec.hs
@@ -16,15 +16,19 @@
 import qualified Data.Text as T
 import Database.Persist.EntityDef.Internal
 import Database.Persist.Quasi
-import Database.Persist.Quasi.PersistSettings
-import Database.Persist.Quasi.PersistSettings.Internal (psTabErrorLevel)
 import Database.Persist.Quasi.Internal
 import Database.Persist.Quasi.Internal.ModelParser
+import Database.Persist.Quasi.Internal.TypeParser
+import Database.Persist.Quasi.PersistSettings
+import Database.Persist.Quasi.PersistSettings.Internal
+    ( psQuotedArgumentErrorLevel
+    , psTabErrorLevel
+    )
 import Database.Persist.Types
 import Test.Hspec
 import Test.QuickCheck
-import Text.Shakespeare.Text (st)
 import Text.Megaparsec (errorBundlePretty, some)
+import Text.Shakespeare.Text (st)
 
 defs :: T.Text -> [UnboundEntityDef]
 defs = defsWithSettings lowerCaseSettings
@@ -32,10 +36,11 @@
 defsSnake :: T.Text -> [UnboundEntityDef]
 defsSnake = defsWithSettings $ setPsUseSnakeCaseForeignKeys lowerCaseSettings
 
-defsWithWarnings :: PersistSettings -> T.Text -> (Set ParserWarning, [UnboundEntityDef])
+defsWithWarnings
+    :: PersistSettings -> T.Text -> (Set ParserWarning, [UnboundEntityDef])
 defsWithWarnings ps t = case cpr of
-                           (warnings, Right res) -> (warnings, res)
-                           (_warnings, Left errs) -> error $ renderErrors errs
+    (warnings, Right res) -> (warnings, res)
+    (_warnings, Left errs) -> error $ renderErrors errs
   where
     cpr = parse ps [(Nothing, t)]
 
@@ -46,15 +51,28 @@
 warningSpecs :: Spec
 warningSpecs =
   describe "Quasi" $ do
-      describe "parser settings" $ do
+      describe "psTabErrorLevel parser setting" $ do
           let
               definitions = T.pack "User\n\tId Text\n\tname String"
-              (warnings, [user]) = defsWithWarnings lowerCaseSettings{ psTabErrorLevel = Just LevelWarning } definitions
+              (warnings, [user]) =
+                defsWithWarnings lowerCaseSettings { psTabErrorLevel = Just LevelWarning
+                                                   }
+                                 definitions
           it "generates warnings" $ do
             Set.map parserWarningMessage warnings
               `shouldBe` [ "use spaces instead of tabs\n2:1:\n  |\n2 |  Id Text\n  | ^\nunexpected tab\nexpecting valid whitespace\n"
                          , "use spaces instead of tabs\n3:1:\n  |\n3 |  name String\n  | ^\nunexpected tab\nexpecting valid whitespace\n"
                          ]
+      describe "psQuotedArgumentErrorLevel parser setting" $ do
+          let
+              definitions = T.pack "User\n Id \"Text\"\n name String\n deriving \"Eq\""
+              (warnings, [user]) =
+                defsWithWarnings lowerCaseSettings { psQuotedArgumentErrorLevel = Just LevelWarning
+                                                   }
+                                 definitions
+          it "generates warnings" $ do
+            Set.map parserWarningMessage warnings
+              `shouldBe` ["Quoted field attributes are deprecated since 2.17.1.0, and will be removed in or after 2.18.0.0\n2:5:\n  |\n2 | Id \"Text\"\n  |     ^\nUnexpected quotation mark in field or directive attribute\n","Quoted field attributes are deprecated since 2.17.1.0, and will be removed in or after 2.18.0.0\n4:11:\n  |\n4 | deriving \"Eq\"\n  |           ^\nUnexpected quotation mark in field or directive attribute\n"]
 #else
 warningSpecs :: Spec
 warningSpecs = pure ()
@@ -111,219 +129,454 @@
                         , unboundFieldGenerated = Nothing
                         }
 
-    describe "tokenization" $ do
+    describe "type parsing" $ do
         let
-            tokenize :: String -> ParseResult [Token]
-            tokenize s = do
-              let (warnings, res) = runConfiguredParser defaultPersistSettings initialExtraState (some anyToken) "" s
-              case res of
-                Left peb ->
-                  (warnings, Left peb)
-                Right (tokens, _acc) -> (warnings, Right tokens)
+            parseType :: String -> ParseResult TypeExpr
+            parseType s = do
+                let
+                    (warnings, res) =
+                        runConfiguredParser defaultPersistSettings initialExtraState innerTypeExpr "" s
+                case res of
+                    Left peb -> (warnings, Left peb)
+                    Right (te, _acc) -> (warnings, Right te)
 
+            isType typeStr expectedTypeExpr = do
+                let
+                    (_warnings, Right te) = parseType typeStr
+                te `shouldBe` expectedTypeExpr
+                typeExprContent te `shouldBe` T.pack typeStr
+
+            -- these are some helper functions to make expectations less verbose
+            simpleType s = (TypeApplication (TypeConstructorExpr (TypeConstructor s)) [])
+            typeApp s ts = (TypeApplication (TypeConstructorExpr (TypeConstructor s)) ts)
+            listOf t = (TypeApplication (TypeConstructorExpr ListConstructor) [t])
+
+        it "parses types of kind '*'" $ do
+            "String" `isType` simpleType "String"
+
+        it "parses type constructors with dots" $ do
+            "ThisIs.AType" `isType` simpleType "ThisIs.AType"
+
+        it "parses higher-kinded types" $ do
+            "Maybe String" `isType` typeApp "Maybe" [simpleType "String"]
+
+        it "is greedy when parsing arguments to a type constructor" $ do
+            "Map String Int" `isType` typeApp "Map" [simpleType "String", simpleType "Int"]
+
+        it "parses higher-kinded types when parameterized by complex types (1)" $ do
+            "Map String (Maybe [Int])"
+                `isType` typeApp "Map" [simpleType "String", typeApp "Maybe" [listOf (simpleType "Int")]]
+
+        it "parses higher-kinded types when parameterized by complex types (2)" $ do
+            "Map (Maybe Int) [Int]"
+                `isType` typeApp "Map" [(typeApp "Maybe" [simpleType "Int"]), listOf (simpleType "Int")]
+
+        it "parses type expressions constructed by a partially parameterized type" $ do
+            "(Map String) [Int]"
+                `isType` TypeApplication
+                    (typeApp "Map" [(simpleType "String")])
+                    [listOf (simpleType "Int")]
+
+        it "parses lists of lists" $ do
+            "[[Maybe String]]"
+                `isType` listOf (listOf (typeApp "Maybe" [simpleType "String"]))
+
+        it "parses list types of complex types" $ do
+            "[(Map String) [Int]]"
+                `isType` listOf
+                    ( TypeApplication
+                        (typeApp "Map" [(simpleType "String")])
+                        [listOf (simpleType "Int")]
+                    )
+
+        it "parses type-level String literals" $ do
+            "Labelled \"abcd\"" `isType` typeApp "Labelled" [TypeLitString "abcd"]
+
+        it "parses type-level Int literals" $ do
+            "Val 3" `isType` typeApp "Val" [TypeLitInt "3"]
+
+        it "parses promoted type constructors" $ do
+            "'Maybe" `isType` TypeLitPromotedConstructor (TypeConstructor "Maybe")
+
+    describe "field name parsing" $ do
+        let
+            parseFieldName :: String -> ParseResult FieldName
+            parseFieldName s = do
+                let
+                    (warnings, res) = runConfiguredParser defaultPersistSettings initialExtraState fieldName "" s
+                case res of
+                    Left peb ->
+                        (warnings, Left peb)
+                    Right (fn, _acc) -> (warnings, Right fn)
+
+        it "parses alphanumeric field names" $
+            parseFieldName "asdf100"
+                `shouldBe` ([], Right (FieldName "asdf100"))
+
+        it "parses alphanumeric field names with underscores" $
+            parseFieldName "asdf_100"
+                `shouldBe` ([], Right (FieldName "asdf_100"))
+
+    describe "attribute parsing" $ do
+        let
+            parseAttributes :: String -> ParseResult [Attribute]
+            parseAttributes s = do
+                let
+                    (warnings, res) =
+                        runConfiguredParser
+                            defaultPersistSettings
+                            initialExtraState
+                            (some attribute)
+                            ""
+                            s
+                case res of
+                    Left peb ->
+                        (warnings, Left peb)
+                    Right (tokens, _acc) -> (warnings, Right tokens)
+
         it "handles normal words" $
-            tokenize "foo   bar  baz"
-                `shouldBe` ([], Right
-                             ( [ PText "foo"
-                               , PText "bar"
-                               , PText "baz"
-                               ]
-                             )
+            parseAttributes "foo   bar  baz"
+                `shouldBe` ( []
+                           , Right
+                                ( [ PText "foo"
+                                  , PText "bar"
+                                  , PText "baz"
+                                  ]
+                                )
                            )
 
+        it "handles bangs" $
+            parseAttributes "foo   !bar  baz"
+                `shouldBe` ( []
+                           , Right
+                                ( [ PText "foo"
+                                  , PText "!bar"
+                                  , PText "baz"
+                                  ]
+                                )
+                           )
+
         it "handles numbers" $
-            tokenize "one (Finite 1)"
-                `shouldBe` ([], Right
-                             ( [ PText "one"
-                               , Parenthetical "Finite 1"
-                               ]
-                             )
+            parseAttributes "one (Finite 1)"
+                `shouldBe` ( []
+                           , Right
+                                ( [ PText "one"
+                                  , Parenthetical "Finite 1"
+                                  ]
+                                )
                            )
 
         it "handles quotes" $
-            tokenize "\"foo bar\" \"baz\""
-                `shouldBe` ([], Right
-                             ( [ Quotation "foo bar"
-                               , Quotation "baz"
-                               ]
-                             )
+            parseAttributes "abc=\"foo bar\" def=\"baz\""
+                `shouldBe` ( []
+                           , Right
+                                ( [ Assignment "abc" "foo bar"
+                                  , Assignment "def" "baz"
+                                  ]
+                                )
                            )
 
         it "handles SQL literals with no specified type" $
-            tokenize "attr='[\"ab\\'cd\", 1, 2]'"
-                `shouldBe` ([], Right
-                             ( [Equality "attr" "'[\"ab'cd\", 1, 2]'"]
-                             )
+            parseAttributes "attr='[\"ab\\'cd\", 1, 2]'"
+                `shouldBe` ( []
+                           , Right
+                                ([Assignment "attr" "'[\"ab'cd\", 1, 2]'"])
                            )
 
         it "handles SQL literals with a specified type" $
-            tokenize "attr='{\"\\'a\\'\": [1, 2.2, \"\\'3\\'\"]}'::type_name"
-                `shouldBe` ([], Right
-                             ( [Equality "attr" "'{\"'a'\": [1, 2.2, \"'3'\"]}'::type_name"]
-                             )
+            parseAttributes "attr='{\"\\'a\\'\": [1, 2.2, \"\\'3\\'\"]}'::type_name"
+                `shouldBe` ( []
+                           , Right
+                                ([Assignment "attr" "'{\"'a'\": [1, 2.2, \"'3'\"]}'::type_name"])
                            )
 
-        it "should error if quotes are unterminated" $ do
-          (fmap . first) errorBundlePretty (tokenize "\"foo bar")
-                `shouldBe` ([], Left
-                             ( "1:9:\n  |\n1 | \"foo bar\n  |         ^\nunexpected end of input\nexpecting '\"' or literal character\n"
-                             )
+        it "handles commas in tokens" $
+            parseAttributes "x=COALESCE(left,right)  baz"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Assignment "x" "COALESCE(left,right)"
+                                  , PText "baz"
+                                  ]
+                                )
                            )
 
-        it "handles commas in tokens" $
-            tokenize "x=COALESCE(left,right)  \"baz\""
-                `shouldBe` ([], Right
-                             ( [ Equality "x" "COALESCE(left,right)"
-                               , Quotation "baz"
-                               ]
-                             )
+        it "handles single quotes in tokens" $
+            parseAttributes "x=blorp('blap')  baz"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Assignment "x" "blorp('blap')"
+                                  , PText "baz"
+                                  ]
+                                )
                            )
 
+        it "handles spaces in assignment RHSes" $
+            parseAttributes "sql=blorp('blap', 'blip')  baz"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Assignment "sql" "blorp('blap', 'blip')"
+                                  , PText "baz"
+                                  ]
+                                )
+                           )
+
         it "handles quotes mid-token" $
-            tokenize "x=\"foo bar\"  \"baz\""
-                `shouldBe` ([], Right
-                             ( [ Equality "x" "foo bar"
-                               , Quotation "baz"
-                               ]
-                             )
+            parseAttributes "x=\"foo bar\"  baz"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Assignment "x" "foo bar"
+                                  , PText "baz"
+                                  ]
+                                )
                            )
 
         it "handles escaped quotes mid-token" $
-            tokenize "x=\\\"foo bar\"  \"baz\""
-                `shouldBe` ([], Right
-                             ( [ Equality "x" "\\\"foo"
-                               , PText "bar\""
-                               , Quotation "baz"
-                               ]
-                             )
+            parseAttributes "x=\\\"foo bar\"  baz"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Assignment "x" "\\\"foo"
+                                  , PText "bar\""
+                                  , PText "baz"
+                                  ]
+                                )
                            )
 
         it "handles unnested parentheses" $
-            tokenize "(foo bar)  (baz)"
-                `shouldBe` ([], Right
-                             ( [ Parenthetical "foo bar"
-                               , Parenthetical "baz"
-                               ]
-                             )
+            parseAttributes "(foo bar)  (baz)"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Parenthetical "foo bar"
+                                  , Parenthetical "baz"
+                                  ]
+                                )
                            )
 
         it "handles unnested parentheses mid-token" $
-            tokenize "x=(foo bar)  (baz)"
-                `shouldBe` ([], Right
-                             ( [ Equality "x" "foo bar"
-                               , Parenthetical "baz"
-                               ]
-                             )
+            parseAttributes "x=(foo bar)  (baz)"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Assignment "x" "foo bar"
+                                  , Parenthetical "baz"
+                                  ]
+                                )
                            )
 
         it "handles nested parentheses" $
-            tokenize "(foo (bar))  (baz)"
-                `shouldBe` ([], Right
-                             ( [ Parenthetical "foo (bar)"
-                               , Parenthetical "baz"
-                               ]
-                             )
+            parseAttributes "(foo (bar))  (baz)"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Parenthetical "foo (bar)"
+                                  , Parenthetical "baz"
+                                  ]
+                                )
                            )
 
         it "handles escaped quotation marks in plain tokens" $
-            tokenize "foo bar\\\"baz"
-                `shouldBe` ([], Right
-                             ( [ PText "foo"
-                               , PText "bar\\\"baz"
-                               ]
-                             )
+            parseAttributes "foo bar\\\"baz"
+                `shouldBe` ( []
+                           , Right
+                                ( [ PText "foo"
+                                  , PText "bar\\\"baz"
+                                  ]
+                                )
                            )
 
         it "handles escaped quotation marks in quotations" $
-            tokenize "foo \"bar\\\"baz\""
-                `shouldBe` ([], Right
-                             ( [ PText "foo"
-                               , Quotation "bar\"baz"
-                               ]
-                             )
+            parseAttributes "foo bar=\"baz\\\"quux\""
+                `shouldBe` ( []
+                           , Right
+                                ( [ PText "foo"
+                                  , Assignment "bar" "baz\"quux"
+                                  ]
+                                )
                            )
 
         it "handles escaped quotation marks in equalities" $
-            tokenize "y=\"baz\\\"\""
-                `shouldBe` ([], Right
-                             ( [ Equality "y" "baz\""
-                               ]
-                             )
+            parseAttributes "y=\"baz\\\"\""
+                `shouldBe` ( []
+                           , Right
+                                ( [ Assignment "y" "baz\""
+                                  ]
+                                )
                            )
 
         it "handles escaped quotation marks in parentheticals" $
-            tokenize "(foo \\\"bar)"
-                `shouldBe` ([], Right
-                             ( [ Parenthetical "foo \\\"bar"
-                               ]
-                             )
+            parseAttributes "(foo \\\"bar)"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Parenthetical "foo \\\"bar"
+                                  ]
+                                )
                            )
 
         it "handles escaped parentheses in quotations" $
-            tokenize "foo \"bar\\(baz\""
-                `shouldBe` ([], Right
-                             ( [ PText "foo"
-                               , Quotation "bar(baz"
-                               ]
-                             )
+            parseAttributes "foo bar=\"baz\\(quux\""
+                `shouldBe` ( []
+                           , Right
+                                ( [ PText "foo"
+                                  , Assignment "bar" "baz(quux"
+                                  ]
+                                )
                            )
 
         it "handles escaped parentheses in plain tokens" $
-            tokenize "foo bar\\(baz"
-                `shouldBe` ([], Right
-                             ( [ PText "foo"
-                               , PText "bar(baz"
-                               ]
-                             )
+            parseAttributes "foo bar\\(baz"
+                `shouldBe` ( []
+                           , Right
+                                ( [ PText "foo"
+                                  , PText "bar(baz"
+                                  ]
+                                )
                            )
 
         it "handles escaped parentheses in parentheticals" $
-            tokenize "(foo \\(bar)"
-                `shouldBe` ([], Right
-                             ( [ Parenthetical "foo (bar"
-                               ]
-                             )
+            parseAttributes "(foo \\(bar)"
+                `shouldBe` ( []
+                           , Right
+                                ( [ Parenthetical "foo (bar"
+                                  ]
+                                )
                            )
 
         it "handles escaped parentheses in equalities" $
-            tokenize "y=baz\\("
-                `shouldBe` ([], Right
-                             ( [ Equality "y" "baz("
-                               ]
-                             )
+            parseAttributes "y=baz\\("
+                `shouldBe` ( []
+                           , Right
+                                ( [ Assignment "y" "baz("
+                                  ]
+                                )
                            )
 
         it "handles mid-token quote in later token" $
-            tokenize "foo bar baz=(bin\")"
-                `shouldBe` ([], Right
-                             ( [ PText "foo"
-                               , PText "bar"
-                               , Equality "baz" "bin\""
-                               ]
-                             )
+            parseAttributes "foo bar baz=(bin\")"
+                `shouldBe` ( []
+                           , Right
+                                ( [ PText "foo"
+                                  , PText "bar"
+                                  , Assignment "baz" "bin\""
+                                  ]
+                                )
                            )
 
-    describe "parser settings" $ do
-      let definitions = T.pack "User\n\tId Text\n\tname String"
+    describe "entity field parsing" $ do
+        let
+            parseField :: String -> ParseResult ()
+            parseField s = do
+                let
+                    (warnings, res) = runConfiguredParser defaultPersistSettings initialExtraState entityField "" s
+                case res of
+                    Left peb ->
+                        (warnings, Left peb)
+                    Right (_, _) -> (warnings, Right ())
 
-      describe "when configured to permit tabs" $ do
+        it "should error if quotes are unterminated in an attribute" $ do
+            (fmap . first) errorBundlePretty (parseField "field String sql=\"foo bar")
+                `shouldBe` ( []
+                           , Left
+                                ( "1:17:\n  |\n1 | field String sql=\"foo bar\n  |                 ^\nunexpected '='\nexpecting '!', '\"', ''', ',', '-', '.', ':', '[', '\\', ']', '_', '~', alphanumeric character, assignment expression, end of input, newline, parenthetical, or plain attribute\n"
+                                )
+                           )
+
+        it "should error if quotes are unterminated in a type" $ do
+            (fmap . first) errorBundlePretty (parseField "field (Label \"unterminated)")
+                `shouldBe` ( []
+                           , Left
+                                ( "1:28:\n  |\n1 | field (Label \"unterminated)\n  |                            ^\nunexpected end of input\nexpecting '\"' or literal character\n"
+                                )
+                           )
+
+    describe "tab error level setting" $ do
         let
-            [user] = defsWithSettings lowerCaseSettings{ psTabErrorLevel = Nothing } definitions
-        it "permits tab indentation" $
-          getUnboundEntityNameHS user `shouldBe` EntityNameHS "User"
+            definitions = T.pack "User\n\tId Text\n\tname String"
 
-      describe "when configured to warn on tabs" $ do
+        describe "when configured to permit tabs" $ do
+            let
+                (warnings, [user]) = defsWithWarnings lowerCaseSettings{psTabErrorLevel = Nothing} definitions
+
+            it "permits tab indentation" $
+                getUnboundEntityNameHS user `shouldBe` EntityNameHS "User"
+
+        describe "when configured to warn on tabs" $ do
+            let
+                (warnings, [user]) =
+                    defsWithWarnings
+                        lowerCaseSettings{psTabErrorLevel = Just LevelWarning}
+                        definitions
+
+            it "permits tab indentation" $
+                getUnboundEntityNameHS user `shouldBe` EntityNameHS "User"
+
+        describe "when configured to disallow tabs" $ do
+            let
+                [user] =
+                    defsWithSettings
+                        lowerCaseSettings{psTabErrorLevel = Just LevelError}
+                        definitions
+
+            it "rejects tab indentation" $
+                evaluate (unboundEntityDef user)
+                    `shouldErrorWithMessage` "2:1:\n  |\n2 |  Id Text\n  | ^\nunexpected tab\nexpecting valid whitespace\n\n3:1:\n  |\n3 |  name String\n  | ^\nunexpected tab\nexpecting valid whitespace\n"
+
+    describe "quoted attribute error level setting" $ do
         let
-            (warnings, [user]) = defsWithWarnings lowerCaseSettings{ psTabErrorLevel = Just LevelWarning } definitions
-        it "permits tab indentation" $
-          getUnboundEntityNameHS user `shouldBe` EntityNameHS "User"
+            definitions = T.pack "User\n name String \"Maybe\""
 
-      describe "when configured to disallow tabs" $ do
+        describe "when configured to warn on quoted attributes" $ do
+            let
+                (warnings, [user]) =
+                    defsWithWarnings
+                        lowerCaseSettings{psQuotedArgumentErrorLevel = Just LevelWarning}
+                        definitions
+
+            it "permits quoted attributes" $
+                (unboundFieldAttrs <$> unboundEntityFields user) `shouldBe` [[FieldAttrMaybe]]
+
+        describe "when configured to disallow quoted attributes" $ do
+            let
+                (warnings, [user]) =
+                    defsWithWarnings
+                        lowerCaseSettings{psQuotedArgumentErrorLevel = Just LevelError}
+                        definitions
+
+            it "rejects quoted attributes" $
+                evaluate (unboundEntityDef user)
+                    `shouldErrorWithMessage` "2:14:\n  |\n2 |  name String \"Maybe\"\n  |              ^\nUnexpected quotation mark in field or directive attribute\n"
+
+            describe "and the definition has quotation marks in the type" $ do
+                let
+                    definitionsWithTypeLevelString = T.pack "User\n name \"String\"\n deriving Show"
+                    (warnings2, [user]) =
+                        defsWithWarnings
+                            lowerCaseSettings{psQuotedArgumentErrorLevel = Just LevelError}
+                            definitionsWithTypeLevelString
+                it "parses successfully" $
+                    getUnboundEntityNameHS user `shouldBe` EntityNameHS "User"
+
+    describe "quoted directive argument error level setting" $ do
         let
-          [user] = defsWithSettings lowerCaseSettings{ psTabErrorLevel = Just LevelError } definitions
-        it "rejects tab indentation" $
-          evaluate (unboundEntityDef user) `shouldErrorWithMessage` "2:1:\n  |\n2 |  Id Text\n  | ^\nunexpected tab\nexpecting valid whitespace\n\n3:1:\n  |\n3 |  name String\n  | ^\nunexpected tab\nexpecting valid whitespace\n"
+            definitions = T.pack "User\n name String\n deriving \"Show\""
 
+        describe "when configured to warn on quoted arguments" $ do
+            let
+                (warnings, [user]) =
+                    defsWithWarnings
+                        lowerCaseSettings{psQuotedArgumentErrorLevel = Just LevelWarning}
+                        definitions
+
+            it "permits quoted attributes" $
+                getUnboundEntityNameHS user `shouldBe` EntityNameHS "User"
+
+        describe "when configured to disallow quoted arguments" $ do
+            let
+                (warnings, [user]) =
+                    defsWithWarnings
+                        lowerCaseSettings{psQuotedArgumentErrorLevel = Just LevelError}
+                        definitions
+
+            it "rejects quoted arguments" $
+                evaluate (unboundEntityDef user)
+                    `shouldErrorWithMessage` "3:11:\n  |\n3 |  deriving \"Show\"\n  |           ^\nUnexpected quotation mark in field or directive attribute\n"
+
     describe "parse" $ do
         let
             subject =
@@ -383,14 +636,37 @@
 
         it "should parse the `entityUniques` field" $ do
             let
-              simplifyUnique unique =
-                (uniqueHaskell unique, uniqueFields unique)
+                simplifyUnique unique =
+                    (uniqueHaskell unique, uniqueFields unique)
             (simplifyUnique <$> entityUniques (unboundEntityDef bicycle)) `shouldBe` []
             (simplifyUnique <$> entityUniques (unboundEntityDef car))
-              `shouldBe` [ (ConstraintNameHS "UniqueModel", [(FieldNameHS "model", FieldNameDB "model")])
-                         ]
+                `shouldBe` [ (ConstraintNameHS "UniqueModel", [(FieldNameHS "model", FieldNameDB "model")])
+                           ]
             (simplifyUnique <$> entityUniques (unboundEntityDef vehicle)) `shouldBe` []
 
+        it "should parse quoted attributes" $ do
+            let
+                [precompiledCacheParent] =
+                    defs
+                        [st|
+                                                   PrecompiledCacheParent sql="precompiled_cache"
+                                                     platformGhcDir FilePath "default=(hex(randomblob(16)))"
+                                                     deriving Show
+                                                |]
+            (unboundFieldAttrs <$> unboundEntityFields precompiledCacheParent)
+                `shouldBe` [[FieldAttrDefault "(hex(randomblob(16)))"]]
+
+        it "should parse entity block attributes with nested parens on equality rhs" $ do
+            let
+                [precompiledCacheParent] =
+                    defs
+                        [st|
+                                                   PrecompiledCacheParent sql="precompiled_cache"
+                                                     platformGhcDir FilePath default=(hex(randomblob(16)))
+                                                |]
+            (unboundFieldAttrs <$> unboundEntityFields precompiledCacheParent)
+                `shouldBe` [[FieldAttrDefault "hex(randomblob(16))"]]
+
         it "should parse the `entityForeigns` field" $ do
             let
                 [user, notification] =
@@ -462,7 +738,7 @@
             let
                 [user] = defs definitions
             evaluate (unboundEntityDef user)
-                `shouldErrorWithMessage` "4:20:\n  |\n4 |     age  (Maybe Int\n  |                    ^\nunexpected newline\nexpecting '!', '\"', ''', '(', ')', ',', '-', '.', ':', '[', '\\', ']', '_', '~', alphanumeric character, space, or tab\n"
+                `shouldErrorWithMessage` "4:20:\n  |\n4 |     age  (Maybe Int\n  |                    ^\nunexpected newline\nexpecting ''', ')', '.', alphanumeric character, type expression, or white space\n"
 
         it "errors on duplicate cascade update declarations" $ do
             let
@@ -868,8 +1144,7 @@
         it "application" $
             parseFieldType "Foo Bar"
                 `shouldBe` Right
-                    ( FTTypeCon Nothing "Foo" `FTApp` FTTypeCon Nothing "Bar"
-                    )
+                    (FTTypeCon Nothing "Foo" `FTApp` FTTypeCon Nothing "Bar")
         it "application multiple" $
             parseFieldType "Foo Bar Baz"
                 `shouldBe` Right
@@ -883,8 +1158,7 @@
                 baz = FTTypeCon Nothing "Baz"
             parseFieldType "Foo (Bar Baz)"
                 `shouldBe` Right
-                    ( foo `FTApp` (bar `FTApp` baz)
-                    )
+                    (foo `FTApp` (bar `FTApp` baz))
         it "lists" $ do
             let
                 foo = FTTypeCon Nothing "Foo"
@@ -893,8 +1167,7 @@
                 baz = FTTypeCon Nothing "Baz"
             parseFieldType "Foo [Bar] Baz"
                 `shouldBe` Right
-                    ( foo `FTApp` bars `FTApp` baz
-                    )
+                    (foo `FTApp` bars `FTApp` baz)
         it "numeric type literals" $ do
             let
                 expected = FTApp (FTTypeCon Nothing "Finite") (FTLit (IntTypeLit 1))
diff --git a/test/Database/Persist/TH/ForeignRefSpec.hs b/test/Database/Persist/TH/ForeignRefSpec.hs
--- a/test/Database/Persist/TH/ForeignRefSpec.hs
+++ b/test/Database/Persist/TH/ForeignRefSpec.hs
@@ -1,4 +1,11 @@
 {-# LANGUAGE DataKinds #-}
+--
+-- DeriveAnyClass is not actually used by persistent-template
+-- But a long standing bug was that if it was enabled, it was used to derive instead of GeneralizedNewtypeDeriving
+-- This was fixed by using DerivingStrategies to specify newtype deriving should be used.
+-- This pragma is left here as a "test" that deriving works when DeriveAnyClass is enabled.
+-- See https://github.com/yesodweb/persistent/issues/578
+{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE ExistentialQuantification #-}
@@ -13,21 +20,14 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
---
--- DeriveAnyClass is not actually used by persistent-template
--- But a long standing bug was that if it was enabled, it was used to derive instead of GeneralizedNewtypeDeriving
--- This was fixed by using DerivingStrategies to specify newtype deriving should be used.
--- This pragma is left here as a "test" that deriving works when DeriveAnyClass is enabled.
--- See https://github.com/yesodweb/persistent/issues/578
-{-# LANGUAGE DeriveAnyClass #-}
 
 module Database.Persist.TH.ForeignRefSpec where
 
-import Control.Applicative (Const(..))
+import Control.Applicative (Const (..))
 import Data.Aeson
 import Data.ByteString.Lazy.Char8 ()
 import Data.Coerce
-import Data.Functor.Identity (Identity(..))
+import Data.Functor.Identity (Identity (..))
 import Data.Int
 import qualified Data.List as List
 import Data.Proxy
@@ -45,7 +45,9 @@
 import Database.Persist.TH
 import TemplateTestImports
 
-mkPersist sqlSettings [persistLowerCase|
+mkPersist
+    sqlSettings
+    [persistLowerCase|
 
 HasCustomName sql=custom_name
     name Text
@@ -96,8 +98,7 @@
                 entityDef $ Proxy @HasCustomName
         it "should have a custom db name" $ do
             entityDB edef
-                `shouldBe`
-                    EntityNameDB "custom_name"
+                `shouldBe` EntityNameDB "custom_name"
 
     it "should compile" $ do
         True `shouldBe` True
@@ -110,8 +111,7 @@
                 entityForeigns fpsDef
         it "has the right type" $ do
             foreignPrimarySourceFk_name_target (ForeignPrimarySource "asdf")
-                `shouldBe`
-                    ForeignPrimaryKey "asdf"
+                `shouldBe` ForeignPrimaryKey "asdf"
 
     describe "Cascade" $ do
         describe "Explicit" $ do
@@ -123,34 +123,33 @@
                 childForeigns =
                     entityForeigns childDef
             it "should have a single foreign reference defined" $ do
-                    case entityForeigns childDef of
-                        [a] ->
-                            pure ()
-                        as ->
-                            expectationFailure . mconcat $
-                                [ "Expected one foreign reference on childDef, "
-                                , "got: "
-                                , show as
-                                ]
+                case entityForeigns childDef of
+                    [a] ->
+                        pure ()
+                    as ->
+                        expectationFailure . mconcat $
+                            [ "(Explicit) Expected one foreign reference on childDef, "
+                            , "got: "
+                            , show as
+                            ]
             let
-                [ForeignDef {..}] =
+                [ForeignDef{..}] =
                     childForeigns
 
             describe "ChildExplicit" $ do
                 it "should have the right target table" $ do
-                    foreignRefTableHaskell `shouldBe`
-                        EntityNameHS "ParentExplicit"
-                    foreignRefTableDBName `shouldBe`
-                        EntityNameDB "parent_explicit"
+                    foreignRefTableHaskell
+                        `shouldBe` EntityNameHS "ParentExplicit"
+                    foreignRefTableDBName
+                        `shouldBe` EntityNameDB "parent_explicit"
                 it "should have the right cascade behavior" $ do
                     foreignFieldCascade
-                        `shouldBe`
-                            FieldCascade
-                                { fcOnUpdate =
-                                    Just Cascade
-                                , fcOnDelete =
-                                    Just Cascade
-                                }
+                        `shouldBe` FieldCascade
+                            { fcOnUpdate =
+                                Just Cascade
+                            , fcOnDelete =
+                                Just Cascade
+                            }
                 it "is not nullable" $ do
                     foreignNullable `shouldBe` False
                 it "is to the Primary key" $ do
@@ -168,11 +167,11 @@
                 case childFields of
                     [nameField, parentIdField] -> do
                         it "parentId has reference" $ do
-                            fieldReference parentIdField `shouldBe`
-                                ForeignRef (EntityNameHS "ParentImplicit")
+                            fieldReference parentIdField
+                                `shouldBe` ForeignRef (EntityNameHS "ParentImplicit")
                     as ->
                         error . mconcat $
-                            [ "Expected one foreign reference on childDef, "
+                            [ "(Implicit) Expected one foreign reference on childDef, "
                             , "got: "
                             , show as
                             ]