groundhog-th 0.6.0 → 0.7.0

raw patch · 4 files changed

+122/−83 lines, 4 filesdep ~groundhogPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: groundhog

API changes (from Hackage documentation)

Files

• Database/Groundhog/TH.hs +34/−36
• Database/Groundhog/TH/CodeGen.hs +2/−2
• Database/Groundhog/TH/Settings.hs +84/−43
• groundhog-th.cabal +2/−2

@@ -24,6 +24,11 @@   , firstChar   -- * Utility functions   , mkTHEntityDef+  , mkTHEmbeddedDef+  , mkTHPrimitiveDef+  , applyEntitySettings+  , applyEmbeddedSettings+  , applyPrimitiveSettings   ) where  import Database.Groundhog.Core (delim, UniqueType(..))@@ -37,7 +42,7 @@ import Control.Monad (forM, forM_, when, unless, liftM2) import Data.Char (isUpper, isLower, isSpace, isDigit, toUpper, toLower) import Data.List (nub, (\\))-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)+import Data.Maybe (fromMaybe, isJust, isNothing) import Data.String import Data.Text.Encoding (encodeUtf8) import Data.Yaml as Y (decodeHelper, ParseException(..))@@ -49,9 +54,9 @@   -- | Codegenerator will create a function with this name that will run 'migrate' for each non-polymorphic entity in definition   , migrationFunction :: Maybe String   -- | Functions that produce Haskell code for the entities. In most cases when overriding, the default functions that produce mappings are not replaced but kept along with custom code. Example: @['defaultMkEntityDecs', mkMyDecs]@.-  , mkEntityDecs :: [THEntityDef -> Q [Dec]]-  , mkEmbeddedDecs :: [THEmbeddedDef -> Q [Dec]]-  , mkPrimitiveDecs :: [THPrimitiveDef -> Q [Dec]]+  , mkEntityDecs :: [[THEntityDef] -> Q [Dec]]+  , mkEmbeddedDecs :: [[THEmbeddedDef] -> Q [Dec]]+  , mkPrimitiveDecs :: [[THPrimitiveDef] -> Q [Dec]] }  defaultCodegenConfig :: CodegenConfig@@ -188,11 +193,9 @@ -- The default names of auxiliary datatypes and names used in database are generated using the naming style and can be changed via configuration. -- The datatypes and their generation options are defined via YAML configuration parsed by quasiquoter 'groundhog'.  mkPersist :: CodegenConfig -> PersistDefinitions -> Q [Dec]-mkPersist CodegenConfig{..} (PersistDefinitions defs) = do-  let duplicates = notUniqueBy id $ flip map defs $ \a -> case a of-        PSEntityDef'    e -> psDataName e-        PSEmbeddedDef'  e -> psEmbeddedName e-        PSPrimitiveDef' e -> psPrimitiveName e+mkPersist CodegenConfig{..} PersistDefinitions{..} = do+  let duplicates = notUniqueBy id $ +        map psDataName psEntities ++ map psEmbeddedName psEmbeddeds ++ map psPrimitiveName psPrimitives   unless (null duplicates) $ fail $ "All definitions must be unique. Found duplicates: " ++ show duplicates   let getDecl name = do         info <- reify $ mkName name@@ -203,18 +206,14 @@             _ -> error $ "Unknown declaration type: " ++ name ++ " " ++ show x           _        -> error $ "Only datatypes can be processed: " ++ name       -  entities  <- catMaybes <$> forM defs (\d -> case d of-    PSEntityDef'   e -> Just . either error id . validateEntity   . applyEntitySettings namingStyle e . mkTHEntityDef namingStyle   <$> getDecl (psDataName e)-    _ -> return Nothing)-  embeddeds <- catMaybes <$> forM defs (\d -> case d of-    PSEmbeddedDef' e -> Just . either error id . validateEmbedded . applyEmbeddedSettings e           . mkTHEmbeddedDef namingStyle <$> getDecl (psEmbeddedName e)-    _ -> return Nothing)-  primitives <- catMaybes <$> forM defs (\d -> case d of-    PSPrimitiveDef'     e -> Just .                                 applyPrimitiveSettings e               . mkTHPrimitiveDef namingStyle     <$> getDecl (psPrimitiveName e)-    _ -> return Nothing)-  decs <- fmap concat $ sequence $ (mkEntityDecs <*> entities) ++ ( mkEmbeddedDecs <*> embeddeds) ++ (mkPrimitiveDecs <*> primitives)-  migrateFunc <- maybe (return []) (\name -> mkMigrateFunction name entities) migrationFunction-  return $ migrateFunc ++ decs+  entities   <- forM psEntities $ \e ->+    either error id . validateEntity   . applyEntitySettings namingStyle e . mkTHEntityDef namingStyle    <$> getDecl (psDataName e)+  embeddeds  <- forM psEmbeddeds $ \e ->+    either error id . validateEmbedded . applyEmbeddedSettings e           . mkTHEmbeddedDef namingStyle  <$> getDecl (psEmbeddedName e)+  primitives <- forM psPrimitives $ \e ->+                                         applyPrimitiveSettings e          . mkTHPrimitiveDef namingStyle <$> getDecl (psPrimitiveName e)+  let mkEntityDecs' = maybe id (\name -> (mkMigrateFunction name:)) migrationFunction $ mkEntityDecs+  fmap concat $ sequence $ map ($ entities) mkEntityDecs' ++ map ($ embeddeds) mkEmbeddedDecs ++ map ($ primitives) mkPrimitiveDecs  applyEntitySettings :: NamingStyle -> PSEntityDef -> THEntityDef -> THEntityDef applyEntitySettings style PSEntityDef{..} def@(THEntityDef{..}) =@@ -225,10 +224,9 @@       , thConstructors = thConstructors'       } where   thAutoKey' = maybe thAutoKey (liftM2 applyAutoKeySettings thAutoKey) psAutoKey-   thConstructors' = maybe thConstructors'' (f thConstructors'') $ psConstructors where-    thConstructors'' = maybe id (\_ -> zipWith putAutoKey [0..]) thAutoKey' thConstructors-    putAutoKey cNum cDef@(THConstructorDef{..}) = cDef {thDbAutoKeyName = Just $ mkDbConstrAutoKeyName style (nameBase thDataName) (nameBase thConstrName) cNum}+    thConstructors'' = map checkAutoKey thConstructors+    checkAutoKey cDef@(THConstructorDef{..}) = cDef {thDbAutoKeyName = thAutoKey' >> thDbAutoKeyName}    mkUniqueKey' = mkUniqueKey style (nameBase thDataName) (head thConstructors')   f = foldr $ replaceOne "constructor" psConstrName (nameBase . thConstrName) applyConstructorSettings@@ -257,7 +255,7 @@ applyConstructorSettings PSConstructorDef{..} def@(THConstructorDef{..}) =   def { thPhantomConstrName = fromMaybe thPhantomConstrName psPhantomConstrName       , thDbConstrName = fromMaybe thDbConstrName psDbConstrName-      , thDbAutoKeyName = fromMaybe thDbAutoKeyName psDbAutoKeyName+      , thDbAutoKeyName = psDbAutoKeyName <|> thDbAutoKeyName       , thConstrFields = maybe thConstrFields (f thConstrFields) psConstrFields       , thConstrUniques = maybe thConstrUniques (map convertUnique) psConstrUniques       } where@@ -321,7 +319,7 @@       [] -> return ()       ys -> fail $ "Constraints must have at least one field: " ++ show ys     when (isNothing (thDbAutoKeyName cdef) /= isNothing (thAutoKey def)) $-      fail $ "Presence of autokey definitions should be the same in entity and constructors definitions " ++ show (thDataName def)+      fail $ "Presence of autokey definitions should be the same in entity and constructors definitions " ++ show (thDataName def) ++ ": " ++ show (thDbAutoKeyName cdef) ++ " - " ++ show (thAutoKey def)          -- check that unique keys = [] for multiple constructor datatype   if length constrs > 1 && not (null $ thUniqueKeys def)@@ -371,7 +369,7 @@     InfixC{} -> error $ "Types with infix constructors are not supported" ++ show dName     ForallC{} -> error $ "Types with existential quantification are not supported" ++ show dName    where-    mkConstr' name params = THConstructorDef name (apply mkPhantomName) (apply mkDbConstrName) Nothing params [] where+    mkConstr' name params = THConstructorDef name (apply mkPhantomName) (apply mkDbConstrName) (Just $ apply mkDbConstrAutoKeyName) params [] where       apply f = f dName' (nameBase name) cNum      mkField :: String -> StrictType -> Int -> THFieldDef@@ -591,8 +589,8 @@     Right (Left err) -> fail err     Right (Right result') -> lift (result' :: PersistDefinitions) -defaultMkEntityDecs :: THEntityDef -> Q [Dec]-defaultMkEntityDecs def = do+defaultMkEntityDecs :: [THEntityDef] -> Q [Dec]+defaultMkEntityDecs = fmap concat . mapM (\def -> do   --runIO (print def)   decs <- fmap concat $ sequence $ map ($ def)     [ mkEntityPhantomConstructors@@ -611,10 +609,10 @@     , mkEntityNeverNullInstance     ]   --runIO $ putStrLn $ pprint decs-  return decs+  return decs) -defaultMkEmbeddedDecs :: THEmbeddedDef -> Q [Dec]-defaultMkEmbeddedDecs def = do+defaultMkEmbeddedDecs :: [THEmbeddedDef] -> Q [Dec]+defaultMkEmbeddedDecs = fmap concat . mapM (\def -> do   --runIO (print def)   decs <- fmap concat $ sequence $ map ($ def)     [ mkEmbeddedPersistFieldInstance@@ -622,14 +620,14 @@     , mkEmbeddedInstance     ] --  runIO $ putStrLn $ pprint decs-  return decs+  return decs) -defaultMkPrimitiveDecs :: THPrimitiveDef -> Q [Dec]-defaultMkPrimitiveDecs def = do+defaultMkPrimitiveDecs :: [THPrimitiveDef] -> Q [Dec]+defaultMkPrimitiveDecs = fmap concat . mapM (\def -> do   --runIO (print def)   decs <- fmap concat $ sequence $ map ($ def)     [ mkPrimitivePersistFieldInstance     , mkPrimitivePrimitivePersistFieldInstance     ] --  runIO $ putStrLn $ pprint decs-  return decs+  return decs)

@@ -387,7 +387,7 @@     let name = mkName $ thPhantomConstrName c
     phantom <- [t| ConstructorMarker $(return entity) |]
     let constr = ForallC (thTypeParams def) [EqualP (VarT v) phantom] $ NormalC name []
-    dataD (cxt []) name [PlainTV v] [return constr] []
+    return $ DataD [] name [PlainTV v] [constr] []
   
 mkEntityPhantomConstructorInstances :: THEntityDef -> Q [Dec]
 mkEntityPhantomConstructorInstances def = sequence $ zipWith f [0..] $ thConstructors def where
@@ -406,7 +406,7 @@         let name = mkName $ thUniqueKeyPhantomName u
         phantom <- [t| UniqueMarker $(return entity) |]
         let constr = ForallC (thTypeParams def) [EqualP (VarT v) phantom] $ NormalC name []
-        sequence [dataD (cxt []) name [PlainTV v] [return constr] []]
+        return [DataD [] name [PlainTV v] [constr] []]
       else return []
     
 mkPersistEntityInstance :: THEntityDef -> Q [Dec]

@@ -3,7 +3,6 @@ 
 module Database.Groundhog.TH.Settings
   ( PersistDefinitions(..)
-  , PersistDefinition(..)
   , THEntityDef(..)
   , THEmbeddedDef(..)
   , THPrimitiveDef(..)
@@ -29,13 +28,13 @@ import Control.Applicative
 import Control.Monad (forM, mzero)
 import Data.Aeson
+import Data.Aeson.Types (Pair)
+import qualified Data.Foldable as Fold
 import qualified Data.HashMap.Strict as H
+import Data.Maybe (catMaybes)
+import Data.Text (Text)
 
-data PersistDefinitions = PersistDefinitions {definitions :: [PersistDefinition]} deriving Show
-data PersistDefinition = PSEntityDef' PSEntityDef
-                       | PSEmbeddedDef' PSEmbeddedDef
-                       | PSPrimitiveDef' PSPrimitiveDef
-     deriving Show
+data PersistDefinitions = PersistDefinitions {psEntities :: [PSEntityDef], psEmbeddeds :: [PSEmbeddedDef], psPrimitives :: [PSPrimitiveDef]} deriving Show
 
 -- data SomeData a = U1 { foo :: Int} | U2 { bar :: Maybe String, asc :: Int64, add :: a} | U3 deriving (Show, Eq)
 
@@ -47,12 +46,12 @@   , thUniqueKeys :: [THUniqueKeyDef]
   , thTypeParams :: [TyVarBndr]
   , thConstructors :: [THConstructorDef]
-} deriving Show
+} deriving (Eq, Show)
 
 data THAutoKeyDef = THAutoKeyDef {
     thAutoKeyConstrName :: String
   , thAutoKeyIsDef :: Bool
-} deriving Show
+} deriving (Eq, Show)
 
 data THEmbeddedDef = THEmbeddedDef {
     thEmbeddedName :: Name
@@ -60,13 +59,13 @@   , thDbEmbeddedName :: String -- ^ It is used only to set polymorphic part of name of its container
   , thEmbeddedTypeParams :: [TyVarBndr]
   , thEmbeddedFields :: [THFieldDef]
-} deriving Show
+} deriving (Eq, Show)
 
 data THPrimitiveDef = THPrimitiveDef {
     thPrimitiveName :: Name
   , thPrimitiveDbName :: String -- ^ It is used only to set polymorphic part of name of its container
   , thPrimitiveStringEnumRepresentation :: Bool -- ^ Store in database as string using Show/Read instances (True) or as integer using Enum instance (False).
-} deriving Show
+} deriving (Eq, Show)
 
 data THConstructorDef = THConstructorDef {
     thConstrName    :: Name -- U2
@@ -75,7 +74,7 @@   , thDbAutoKeyName :: Maybe String -- u2_id
   , thConstrFields  :: [THFieldDef]
   , thConstrUniques :: [THUniqueDef]
-} deriving Show
+} deriving (Eq, Show)
 
 data THFieldDef = THFieldDef {
     thFieldName :: String -- bar
@@ -85,14 +84,14 @@   , thFieldType :: Type
   , thEmbeddedDef :: Maybe [PSFieldDef String]
   , thDefaultValue :: Maybe String
-  , thReferenceParent :: Maybe (Maybe (Maybe String, String, [String]), Maybe ReferenceActionType, Maybe ReferenceActionType)
-} deriving Show
+  , thReferenceParent :: Maybe (Maybe ((Maybe String, String), [String]), Maybe ReferenceActionType, Maybe ReferenceActionType)
+} deriving (Eq, Show)
 
 data THUniqueDef = THUniqueDef {
     thUniqueName :: String
   , thUniqueType :: UniqueType
   , thUniqueFields :: [Either String String] -- ^ Either name of field, i.e, thFieldName, or expression
-} deriving Show
+} deriving (Eq, Show)
 
 data THUniqueKeyDef = THUniqueKeyDef {
     thUniqueKeyName :: String
@@ -103,7 +102,7 @@   , thUniqueKeyFields :: [THFieldDef]
   , thUniqueKeyMakeEmbedded :: Bool -- ^ If True, make it an instance of Embedded
   , thUniqueKeyIsDef :: Bool
-} deriving Show
+} deriving (Eq, Show)
 
 data PSEntityDef = PSEntityDef {
     psDataName :: String -- SomeData
@@ -112,34 +111,34 @@   , psAutoKey :: Maybe (Maybe PSAutoKeyDef) -- SomeDataKey. Nothing - default key. Just Nothing - no autokey. Just (Just _) - specify autokey settings
   , psUniqueKeys :: Maybe [PSUniqueKeyDef]
   , psConstructors :: Maybe [PSConstructorDef]
-} deriving Show
+} deriving (Eq, Show)
 
 data PSEmbeddedDef = PSEmbeddedDef {
     psEmbeddedName :: String
   , psDbEmbeddedName :: Maybe String -- ^ It is used only to set polymorphic part of name of its container
   , psEmbeddedFields :: Maybe [PSFieldDef String]
-} deriving Show
+} deriving (Eq, Show)
 
 data PSPrimitiveDef = PSPrimitiveDef {
     psPrimitiveName :: String
   , psPrimitiveDbName :: Maybe String -- ^ It is used only to set polymorphic part of name of its container
   , psPrimitiveStringEnumRepresentation :: Maybe Bool -- ^ Store in database as string using Show/Read instances (True) or as integer using Enum instance (False).
-} deriving Show
+} deriving (Eq, Show)
 
 data PSConstructorDef = PSConstructorDef {
     psConstrName :: String -- U2
   , psPhantomConstrName :: Maybe String -- U2Constructor
   , psDbConstrName :: Maybe String -- SQLU2
-  , psDbAutoKeyName :: Maybe (Maybe String) -- u2_id
+  , psDbAutoKeyName :: Maybe String -- u2_id
   , psConstrFields  :: Maybe [PSFieldDef String]
   , psConstrUniques :: Maybe [PSUniqueDef]
-} deriving Show
+} deriving (Eq, Show)
 
 data PSUniqueDef = PSUniqueDef {
     psUniqueName :: String
   , psUniqueType :: Maybe UniqueType
   , psUniqueFields :: [Either String String]
-} deriving Show
+} deriving (Eq, Show)
 
 data PSUniqueKeyDef = PSUniqueKeyDef {
     psUniqueKeyName :: String
@@ -149,23 +148,18 @@   , psUniqueKeyFields :: Maybe [PSFieldDef String]
   , psUniqueKeyMakeEmbedded :: Maybe Bool
   , psUniqueKeyIsDef :: Maybe Bool
-} deriving Show
+} deriving (Eq, Show)
 
 data PSAutoKeyDef = PSAutoKeyDef {
     psAutoKeyConstrName :: Maybe String
   , psAutoKeyIsDef :: Maybe Bool
-} deriving Show
-
-instance Lift PersistDefinition where
-  lift (PSEntityDef' e) = [| PSEntityDef' e |]
-  lift (PSEmbeddedDef' e) = [| PSEmbeddedDef' e |]
-  lift (PSPrimitiveDef' e) = [| PSPrimitiveDef' e |]
+} deriving (Eq, Show)
 
 instance Lift PSPrimitiveDef where
   lift (PSPrimitiveDef {..}) = [| PSPrimitiveDef $(lift psPrimitiveName) $(lift psPrimitiveDbName) $(lift psPrimitiveStringEnumRepresentation) |]
 
 instance Lift PersistDefinitions where
-  lift (PersistDefinitions {..}) = [| PersistDefinitions $(lift definitions) |]
+  lift (PersistDefinitions {..}) = [| PersistDefinitions $(lift psEntities) $(lift psEmbeddeds) $(lift psPrimitives) |]
 
 instance Lift PSEntityDef where
   lift (PSEntityDef {..}) = [| PSEntityDef $(lift psDataName) $(lift psDbEntityName) $(lift psEntitySchema) $(lift psAutoKey) $(lift psUniqueKeys) $(lift psConstructors) |]
@@ -209,23 +203,22 @@         ---
           entity: name
   -}
-  parseJSON value = PersistDefinitions <$> case value of
+  parseJSON value = (case value of
     Object v -> do
       defs <- v .:? "definitions"
       case defs of
-        Just defs'@(Array _) -> parseJSON defs'
+        Just (Array arr) -> Fold.foldrM go initial arr
+        Nothing -> go value initial
         Just _ -> mzero
-        Nothing -> fmap (\a -> [a]) $ parseJSON value
-    defs@(Array _) -> parseJSON defs
-    _ -> mzero
+    Array arr -> Fold.foldrM go initial arr
+    _ -> mzero) where
+    initial = PersistDefinitions [] [] []
+    go obj p@(PersistDefinitions{..}) = flip (withObject "definition") obj $ \v -> case () of
+      _ | H.member "entity" v -> (\x -> p {psEntities = x:psEntities}) <$> parseJSON obj
+      _ | H.member "embedded" v -> (\x -> p {psEmbeddeds = x:psEmbeddeds}) <$> parseJSON obj
+      _ | H.member "primitive" v -> (\x -> p {psPrimitives = x:psPrimitives}) <$> parseJSON obj
+      _ -> fail $ "Invalid definition: " ++ show obj
 
-instance FromJSON PersistDefinition where
-  parseJSON obj@(Object v) = case () of
-    _ | H.member "entity" v -> PSEntityDef' <$> parseJSON obj
-    _ | H.member "embedded" v -> PSEmbeddedDef' <$> parseJSON obj
-    _ | H.member "primitive" v -> PSPrimitiveDef' <$> parseJSON obj
-    _ -> mzero
-  parseJSON _ = mzero
 
 instance FromJSON PSEntityDef where
   parseJSON = withObject "entity" $ \v ->
@@ -279,8 +272,8 @@     mkRefSettings v = do
       ref <- v .:? "reference"
       (parent, onDel, onUpd) <- case ref of
-        Just (Object r) -> (,,) <$> parentRef <*> r .:? "onDelete" <*> r .:? "onUpdate" where
-          parentRef = optional ((,,) <$> r .:? "schema" <*> r .: "table" <*> r .: "columns")
+        Just (Object r) -> (,,) <$> optional parentRef <*> r .:? "onDelete" <*> r .:? "onUpdate" where
+          parentRef = (,) <$> ((,) <$> r .:? "schema" <*> r .: "table") <*> r .: "columns"
         _ -> pure (Nothing, Nothing, Nothing)
       -- this temporary solution uses onDelete and onUpdate both from inside reference object (preferred) and from field level (for compatibility)
       (onDel', onUpd') <- (,) <$> v .:? "onDelete" <*> v .:? "onUpdate"
@@ -295,3 +288,51 @@ instance FromJSON PSAutoKeyDef where
   parseJSON = withObject "autogenerated key" $ \v ->
     PSAutoKeyDef <$> v .:? "constrName" <*> v .:? "default"
+
+(.=?) :: ToJSON a => Text -> Maybe a -> Maybe Pair
+name .=? value = (name .=) <$> value
+
+(.=:) :: ToJSON a => Text -> Maybe [a] -> Maybe Pair
+name .=: value = case value of
+  Just (_:_) -> Just $ name .= value
+  _          -> Nothing
+
+instance ToJSON PSEntityDef where
+  toJSON PSEntityDef{..} = object $ catMaybes [Just $ "entity" .= psDataName, "dbName" .=? psDbEntityName, "schema" .=? psEntitySchema, "autoKey" .=? psAutoKey, "keys" .=: psUniqueKeys, "constructors" .=: psConstructors]
+
+instance ToJSON PSConstructorDef where
+  toJSON PSConstructorDef{..} = object $ catMaybes [Just $ "name" .= psConstrName, "phantomName" .=? psPhantomConstrName, "dbName" .=? psDbConstrName, "keyDbName" .=? psDbAutoKeyName, "fields" .=: psConstrFields, "uniques" .=: psConstrUniques]
+
+instance ToJSON PSUniqueDef where
+  toJSON PSUniqueDef{..} = object $ catMaybes [Just $ "name" .= psUniqueName, "type" .=? psUniqueType, "fields" .=? fields] where
+    fields = if null psUniqueFields
+      then Nothing
+      else Just $ map (either toJSON (\x -> object ["expr" .= x])) psUniqueFields
+
+instance ToJSON UniqueType where
+  toJSON a = toJSON $ case a of
+    UniqueConstraint -> "constraint" :: String
+    UniqueIndex      -> "index"
+    UniquePrimary _  -> "primary"
+
+instance ToJSON ReferenceActionType where
+  toJSON a = toJSON $ case a of
+    NoAction   -> "no action" :: String
+    Restrict   -> "restrict"
+    Cascade    -> "cascade"
+    SetNull    -> "set null"
+    SetDefault -> "set default"
+
+instance ToJSON (PSFieldDef String) where
+  toJSON PSFieldDef{..} = object $ catMaybes [Just $ "name" .= psFieldName, "dbName" .=? psDbFieldName, "type" .=? psDbTypeName, "exprName" .=? psExprName, "embeddedType" .=: psEmbeddedDef, "default" .=? psDefaultValue, "reference" .=? (psReferenceParent >>= mkRefSettings)] where
+    mkRefSettings (parent, onDel, onUpd) = if null fields then Nothing else Just $ object fields where
+      fields = catMaybes $ parent' ++ ["onDelete" .=? onDel, "onUpdate" .=? onUpd]
+      parent' = case parent of
+        Nothing -> []
+        Just ((schema, table), columns) -> ["schema" .=? schema, Just $ "table" .= table, Just $ "columns" .= columns]
+
+instance ToJSON PSUniqueKeyDef where
+  toJSON PSUniqueKeyDef{..} = object $ catMaybes [Just $ "name" .= psUniqueKeyName, "keyPhantom" .=? psUniqueKeyPhantomName, "constrName" .=? psUniqueKeyConstrName, "dbName" .=? psUniqueKeyDbName, "mkEmbedded" .=? psUniqueKeyMakeEmbedded, "default" .=? psUniqueKeyIsDef, "fields" .=: psUniqueKeyFields]
+
+instance ToJSON PSAutoKeyDef where
+  toJSON PSAutoKeyDef{..} = object $ catMaybes ["constrName" .=? psAutoKeyConstrName, "default" .=? psAutoKeyIsDef]

@@ -1,5 +1,5 @@ name:            groundhog-th-version:         0.6.0+version:         0.7.0 license:         BSD3 license-file:    LICENSE author:          Boris Lykah <lykahb@gmail.com>@@ -17,7 +17,7 @@ library     build-depends:   base                     >= 4         && < 5                    , bytestring               >= 0.9-                   , groundhog                >= 0.6       && < 0.7+                   , groundhog                >= 0.7       && < 0.8                    , template-haskell                    , time                     >= 1.1.4                    , containers               >= 0.2