Derive {From,To}JSON for EntityDef

persistent/ChangeLog.md

@@ -1,5 +1,10 @@
 # Changelog for persistent
 
+## 2.14.7.0 (unreleased)
+
+* [#1540](https://github.com/yesodweb/persistent/pull/1540)
+    * Derive `FromJSON`, `ToJSON`, and `Generic` for `EntityDef` and its dependencies.
+
 ## 2.14.6.1
 
 * [#1528](https://github.com/yesodweb/persistent/pull/1528)

persistent/Database/Persist/Names.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveLift #-}
 
 -- | This module contains types and functions for working with and
@@ -6,7 +7,9 @@
 -- @since 2.13.0.0
 module Database.Persist.Names where
 
+import Data.Aeson (FromJSON, ToJSON)
 import Data.Text (Text)
+import GHC.Generics (Generic)
 import Language.Haskell.TH.Syntax (Lift)
 -- Bring `Lift (Map k v)` instance into scope, as well as `Lift Text`
 -- instance on pre-1.2.4 versions of `text`
@@ -23,7 +26,11 @@ class DatabaseName a where
 --
 -- @since 2.12.0.0
 newtype FieldNameDB = FieldNameDB { unFieldNameDB :: Text }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON FieldNameDB
+
+instance ToJSON FieldNameDB
 
 -- | @since 2.12.0.0
 instance DatabaseName FieldNameDB where
@@ -34,21 +41,33 @@ instance DatabaseName FieldNameDB where
 --
 -- @since 2.12.0.0
 newtype FieldNameHS = FieldNameHS { unFieldNameHS :: Text }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON FieldNameHS
+
+instance ToJSON FieldNameHS
 
 -- | An 'EntityNameHS' represents the Haskell-side name that @persistent@
 -- will use for an entity.
 --
 -- @since 2.12.0.0
 newtype EntityNameHS = EntityNameHS { unEntityNameHS :: Text }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON EntityNameHS
+
+instance ToJSON EntityNameHS
 
 -- | An 'EntityNameDB' represents the datastore-side name that @persistent@
 -- will use for an entity.
 --
 -- @since 2.12.0.0
 newtype EntityNameDB = EntityNameDB { unEntityNameDB :: Text }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON EntityNameDB
+
+instance ToJSON EntityNameDB
 
 instance DatabaseName EntityNameDB where
     escapeWith f (EntityNameDB n) = f n
@@ -58,7 +77,11 @@ instance DatabaseName EntityNameDB where
 --
 -- @since 2.12.0.0
 newtype ConstraintNameDB = ConstraintNameDB { unConstraintNameDB :: Text }
-  deriving (Show, Eq, Read, Ord, Lift)
+  deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON ConstraintNameDB
+
+instance ToJSON ConstraintNameDB
 
 -- | @since 2.12.0.0
 instance DatabaseName ConstraintNameDB where
@@ -69,4 +92,8 @@ instance DatabaseName ConstraintNameDB where
 --
 -- @since 2.12.0.0
 newtype ConstraintNameHS = ConstraintNameHS { unConstraintNameHS :: Text }
-  deriving (Show, Eq, Read, Ord, Lift)
+  deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON ConstraintNameHS
+
+instance ToJSON ConstraintNameHS

persistent/Database/Persist/Types/Base.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveLift #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE PatternSynonyms #-}
@@ -16,6 +17,7 @@ module Database.Persist.Types.Base
     ) where
 
 import Control.Exception (Exception)
+import Data.Aeson (FromJSON, ToJSON)
 import Data.Char (isSpace)
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.List.NonEmpty as NEL
@@ -24,6 +26,7 @@ import Data.Maybe (isNothing)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Word (Word32)
+import GHC.Generics (Generic)
 import Language.Haskell.TH.Syntax (Lift(..))
 import Web.HttpApiData
        ( FromHttpApiData(..)
@@ -156,7 +159,11 @@ data EntityDef = EntityDef
     --
     -- @since 2.10.0
     }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON EntityDef
+
+instance ToJSON EntityDef
 
 -- | The definition for the entity's primary key ID.
 --
@@ -174,7 +181,11 @@ data EntityIdDef
     -- A natural key can have one or more columns.
     --
     -- @since 2.13.0.0
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON EntityIdDef
+
+instance ToJSON EntityIdDef
 
 -- | Return the @['FieldDef']@ for the entity keys.
 entitiesPrimary :: EntityDef -> NonEmpty FieldDef
@@ -389,7 +400,11 @@ data FieldAttr
     -- another column over time.
     | FieldAttrOther Text
     -- ^ A grab bag of random attributes that were unrecognized by the parser.
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON FieldAttr
+
+instance ToJSON FieldAttr
 
 -- | Parse raw field attributes into structured form. Any unrecognized
 -- attributes will be preserved, identically as they are encountered,
@@ -434,12 +449,20 @@ data FieldType
     | FTTypePromoted Text
     | FTApp FieldType FieldType
     | FTList FieldType
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON FieldType
+
+instance ToJSON FieldType
 
 data FieldTypeLit
     = IntTypeLit Integer
     | TextTypeLit Text
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON FieldTypeLit
+
+instance ToJSON FieldTypeLit
 
 isFieldNotGenerated :: FieldDef -> Bool
 isFieldNotGenerated = isNothing . fieldGenerated
@@ -456,7 +479,11 @@ data ReferenceDef
     | EmbedRef EntityNameHS
     | SelfReference
     -- ^ A SelfReference stops an immediate cycle which causes non-termination at compile-time (issue #311).
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON ReferenceDef
+
+instance ToJSON ReferenceDef
 
 -- | An EmbedEntityDef is the same as an EntityDef
 -- But it is only used for fieldReference
@@ -537,13 +564,21 @@ data UniqueDef = UniqueDef
     , uniqueFields  :: !(NonEmpty (FieldNameHS, FieldNameDB))
     , uniqueAttrs   :: ![Attr]
     }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON UniqueDef
+
+instance ToJSON UniqueDef
 
 data CompositeDef = CompositeDef
     { compositeFields  :: !(NonEmpty FieldDef)
     , compositeAttrs   :: ![Attr]
     }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON CompositeDef
+
+instance ToJSON CompositeDef
 
 -- | Used instead of FieldDef
 -- to generate a smaller amount of code
@@ -566,7 +601,11 @@ data ForeignDef = ForeignDef
     --
     -- @since 2.11.0
     }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON ForeignDef
+
+instance ToJSON ForeignDef
 
 -- | This datatype describes how a foreign reference field cascades deletes
 -- or updates.
@@ -581,7 +620,11 @@ data FieldCascade = FieldCascade
     { fcOnUpdate :: !(Maybe CascadeAction)
     , fcOnDelete :: !(Maybe CascadeAction)
     }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON FieldCascade
+
+instance ToJSON FieldCascade
 
 -- | A 'FieldCascade' that does nothing.
 --
@@ -605,7 +648,11 @@ renderFieldCascade (FieldCascade onUpdate onDelete) =
 --
 -- @since 2.11.0
 data CascadeAction = Cascade | Restrict | SetNull | SetDefault
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON CascadeAction
+
+instance ToJSON CascadeAction
 
 -- | Render a 'CascadeAction' to 'Text' such that it can be used in a SQL
 -- command.
@@ -643,7 +690,11 @@ data SqlType = SqlString
              | SqlDayTime -- ^ Always uses UTC timezone
              | SqlBlob
              | SqlOther T.Text -- ^ a backend-specific name
-    deriving (Show, Read, Eq, Ord, Lift)
+    deriving (Show, Read, Eq, Ord, Lift, Generic)
+
+instance FromJSON SqlType
+
+instance ToJSON SqlType
 
 data PersistFilter = Eq | Ne | Gt | Lt | Ge | Le | In | NotIn
                    | BackendSpecificFilter T.Text
@@ -713,4 +764,8 @@ data FieldDef = FieldDef
     --
     -- @since 2.13.0.0
     }
-    deriving (Show, Eq, Read, Ord, Lift)
+    deriving (Show, Eq, Read, Ord, Lift, Generic)
+
+instance FromJSON FieldDef
+
+instance ToJSON FieldDef

persistent/persistent.cabal

@@ -1,5 +1,5 @@
 name:            persistent
-version:         2.14.6.1
+version:         2.14.7.0
 license:         MIT
 license-file:    LICENSE
 author:          Michael Snoyman <[email protected]>