mkEntity :: MkPersistSettings -> EntityDef -> Q [Dec]
mkEntity mps t = do
    t' <- lift t
    let nameT = unHaskellName entName
    let nameS = unpack nameT
    let clazz = ConT ''PersistEntity `AppT` genDataType
    tpf <- mkToPersistFields mps nameS t
    fpv <- mkFromPersistValues mps t
    utv <- mkUniqueToValues $ entityUniques t
    puk <- mkUniqueKeys t
    fkc <- mapM (mkForeignKeysComposite mps t) $ entityForeigns t

    let primaryField = entityId t
    
    fields <- mapM (mkField mps t) $ primaryField : entityFields t
    toFieldNames <- mkToFieldNames $ entityUniques t

    (keyTypeDec, keyInstanceDecs) <- mkKeyTypeDec mps t
    keyToValues' <- mkKeyToValues mps t
    keyFromValues' <- mkKeyFromValues mps t

    let addSyn -- FIXME maybe remove this
            | mpsGeneric mps = (:) $
                TySynD (mkName nameS) [] $
                    genericDataType mps entName $ mpsBackend mps
            | otherwise = id

    lensClauses <- mkLensClauses mps t

    lenses <- mkLenses mps t
    let instanceConstraint = if not (mpsGeneric mps) then [] else
          [mkClassP ''PersistStore [backendT]]

    return $ addSyn $
       dataTypeDec mps t : mconcat fkc `mappend`
      ([ TySynD (keyIdName t) [] $
            ConT ''Key `AppT` ConT (mkName nameS)
      , InstanceD instanceConstraint clazz $
        [ uniqueTypeDec mps t
        , keyTypeDec
        , keyToValues'
        , keyFromValues'
        , FunD 'entityDef [normalClause [WildP] t']
        , tpf
        , FunD 'fromPersistValues fpv
        , toFieldNames
        , utv
        , puk
        , DataInstD
            []
            ''EntityField
            [ genDataType
            , VarT $ mkName "typ"
            ]
            (map fst fields)
            []
        , FunD 'persistFieldDef (map snd fields)
        , TySynInstD
            ''PersistEntityBackend
#if MIN_VERSION_template_haskell(2,9,0)
            (TySynEqn
               [genDataType]
               (backendDataType mps))
#else
            [genDataType]
            (backendDataType mps)
#endif
        , FunD 'persistIdField [normalClause [] (ConE $ keyIdName t)]
        , FunD 'fieldLens lensClauses
        ]
      ] `mappend` lenses) `mappend` keyInstanceDecs
  where
    genDataType = genericDataType mps entName backendT
    entName = entityHaskell t
mkEntity :: MkPersistSettings -> EntityDef -> Q [Dec]
mkEntity mps t = do
    t' <- lift t
    let nameT = unHaskellName entName
    let nameS = unpack nameT
    let clazz = ConT ''PersistEntity `AppT` genDataType
    tpf <- mkToPersistFields mps nameS t
    fpv <- mkFromPersistValues mps t
    utv <- mkUniqueToValues $ entityUniques t
    puk <- mkUniqueKeys t
    fkc <- mapM (mkForeignKeysComposite mps t) $ entityForeigns t

    let primaryField = entityId t
    
    fields <- mapM (mkField mps t) $ primaryField : entityFields t
    toFieldNames <- mkToFieldNames $ entityUniques t

    (keyTypeDec, keyInstanceDecs) <- mkKeyTypeDec mps t
    keyToValues' <- mkKeyToValues mps t
    keyFromValues' <- mkKeyFromValues mps t

    let addSyn -- FIXME maybe remove this
            | mpsGeneric mps = (:) $
                TySynD (mkName nameS) [] $
                    genericDataType mps entName $ mpsBackend mps
            | otherwise = id

    lensClauses <- mkLensClauses mps t

    lenses <- mkLenses mps t
    let instanceConstraint = if not (mpsGeneric mps) then [] else
          [mkClassP ''PersistStore [backendT]]

    return $ addSyn $
       dataTypeDec mps t : mconcat fkc `mappend`
      ([ TySynD (keyIdName t) [] $
            ConT ''Key `AppT` ConT (mkName nameS)
      , InstanceD instanceConstraint clazz $
        [ uniqueTypeDec mps t
        , keyTypeDec
        , keyToValues'
        , keyFromValues'
        , FunD 'entityDef [normalClause [WildP] t']
        , tpf
        , FunD 'fromPersistValues fpv
        , toFieldNames
        , utv
        , puk
        , DataInstD
            []
            ''EntityField
            [ genDataType
            , VarT $ mkName "typ"
            ]
            (map fst fields)
            []
        , FunD 'persistFieldDef (map snd fields)
        , TySynInstD
            ''PersistEntityBackend
#if MIN_VERSION_template_haskell(2,9,0)
            (TySynEqn
               [genDataType]
               (backendDataType mps))
#else
            [genDataType]
            (backendDataType mps)
#endif
        , FunD 'persistIdField [normalClause [] (ConE $ keyIdName t)]
        , FunD 'fieldLens lensClauses
        ]
      ] `mappend` lenses) `mappend` keyInstanceDecs
  where
    genDataType = genericDataType mps entName backendT
    entName = entityHaskell t
mkEntity mps t = do
    t' <- lift t
    let nameT = unHaskellName entName
    let nameS = unpack nameT
    let clazz = ConT ''PersistEntity `AppT` genDataType
    tpf <- mkToPersistFields mps nameS t
    fpv <- mkFromPersistValues mps t
    utv <- mkUniqueToValues $ entityUniques t
    puk <- mkUniqueKeys t
    fkc <- mapM (mkForeignKeysComposite mps t) $ entityForeigns t

    let primaryField = entityId t
    
    fields <- mapM (mkField mps t) $ primaryField : entityFields t
    toFieldNames <- mkToFieldNames $ entityUniques t

    (keyTypeDec, keyInstanceDecs) <- mkKeyTypeDec mps t
    keyToValues' <- mkKeyToValues mps t
    keyFromValues' <- mkKeyFromValues mps t

    let addSyn -- FIXME maybe remove this
            | mpsGeneric mps = (:) $
                TySynD (mkName nameS) [] $
                    genericDataType mps entName $ mpsBackend mps
            | otherwise = id

    lensClauses <- mkLensClauses mps t

    lenses <- mkLenses mps t
    let instanceConstraint = if not (mpsGeneric mps) then [] else
          [mkClassP ''PersistStore [backendT]]

    return $ addSyn $
       dataTypeDec mps t : mconcat fkc `mappend`
      ([ TySynD (keyIdName t) [] $
            ConT ''Key `AppT` ConT (mkName nameS)
      , InstanceD instanceConstraint clazz $
        [ uniqueTypeDec mps t
        , keyTypeDec
        , keyToValues'
        , keyFromValues'
        , FunD 'entityDef [normalClause [WildP] t']
        , tpf
        , FunD 'fromPersistValues fpv
        , toFieldNames
        , utv
        , puk
        , DataInstD
            []
            ''EntityField
            [ genDataType
            , VarT $ mkName "typ"
            ]
            (map fst fields)
            []
        , FunD 'persistFieldDef (map snd fields)
        , TySynInstD
            ''PersistEntityBackend
#if MIN_VERSION_template_haskell(2,9,0)
            (TySynEqn
               [genDataType]
               (backendDataType mps))
#else
            [genDataType]
            (backendDataType mps)
#endif
        , FunD 'persistIdField [normalClause [] (ConE $ keyIdName t)]
        , FunD 'fieldLens lensClauses
        ]
      ] `mappend` lenses) `mappend` keyInstanceDecs
  where
    genDataType = genericDataType mps entName backendT
    entName = entityHaskell t