{-# LANGUAGE TemplateHaskellQuotes #-}

-- | This module contains types and functions for creating an 'ImplicitIdDef',
-- which allows you to customize the implied ID column that @persistent@
-- generates.
--
-- If this module doesn't suit your needs, you may want to import
-- "Database.Persist.ImplicitIdDef.Internal" instead. If you do so, please file
-- an issue on GitHub so we can support your needs. Breaking changes to that
-- module will *not* be accompanied with a major version bump.
--
-- @since 2.13.0.0
module Database.Persist.ImplicitIdDef
    ( -- * The Type
      ImplicitIdDef
      -- * Construction
    , mkImplicitIdDef
    -- * Autoincrementing Integer Key
    , autoIncrementingInteger
    -- * Getters
    -- * Setters
    , setImplicitIdDefMaxLen
    , unsafeClearDefaultImplicitId
    ) where

import Language.Haskell.TH

import Database.Persist.ImplicitIdDef.Internal
import Database.Persist.Types.Base
    ( FieldType(..)
    , SqlType(..)
    )
import Database.Persist.Class (BackendKey)
import Database.Persist.Names

-- | This is the default variant. Setting the implicit ID definition to this
-- value should not have any change at all on how entities are defined by
-- default.
--
-- @since 2.13.0.0
autoIncrementingInteger :: ImplicitIdDef
autoIncrementingInteger :: ImplicitIdDef
autoIncrementingInteger =
    ImplicitIdDef :: (EntityNameHS -> FieldType)
-> SqlType
-> (Bool -> Type -> Type)
-> Maybe Text
-> Maybe Integer
-> ImplicitIdDef
ImplicitIdDef
        { iidFieldType :: EntityNameHS -> FieldType
iidFieldType = \EntityNameHS
entName ->
            Maybe Text -> Text -> FieldType
FTTypeCon Maybe Text
forall a. Maybe a
Nothing (Text -> FieldType) -> Text -> FieldType
forall a b. (a -> b) -> a -> b
$ EntityNameHS -> Text
unEntityNameHS EntityNameHS
entName Text -> Text -> Text
forall a. Monoid a => a -> a -> a
`mappend` Text
"Id"
        , iidFieldSqlType :: SqlType
iidFieldSqlType =
            SqlType
SqlInt64
        , iidType :: Bool -> Type -> Type
iidType = \Bool
isMpsGeneric Type
mpsBackendType ->
            Name -> Type
ConT ''BackendKey Type -> Type -> Type
`AppT`
                if Bool
isMpsGeneric
                then Name -> Type
VarT (String -> Name
mkName String
"backend")
                else Type
mpsBackendType
        , iidDefault :: Maybe Text
iidDefault =
            Maybe Text
forall a. Maybe a
Nothing
        , iidMaxLen :: Maybe Integer
iidMaxLen =
            Maybe Integer
forall a. Maybe a
Nothing
        }