{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Database.Persist.Types.Base
    ( module Database.Persist.Types.Base
    -- * Re-exports
    , PersistValue(..)
    , fromPersistValueText
    , LiteralType(..)
    ) where

import Control.Exception (Exception)
import Data.Char (isSpace)
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
import Data.Map (Map)
import Data.Maybe (isNothing)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Word (Word32)
import Language.Haskell.TH.Syntax (Lift(..))
import Web.HttpApiData
       ( FromHttpApiData(..)
       , ToHttpApiData(..)
       , parseBoundedTextData
       , showTextData
       )
import Web.PathPieces (PathPiece(..))
    -- Bring `Lift (Map k v)` instance into scope, as well as `Lift Text`
    -- instance on pre-1.2.4 versions of `text`
import Instances.TH.Lift ()

import Database.Persist.Names
import Database.Persist.PersistValue

-- | A 'Checkmark' should be used as a field type whenever a
-- uniqueness constraint should guarantee that a certain kind of
-- record may appear at most once, but other kinds of records may
-- appear any number of times.
--
-- /NOTE:/ You need to mark any @Checkmark@ fields as @nullable@
-- (see the following example).
--
-- For example, suppose there's a @Location@ entity that
-- represents where a user has lived:
--
-- @
-- Location
--     user    UserId
--     name    Text
--     current Checkmark nullable
--
--     UniqueLocation user current
-- @
--
-- The @UniqueLocation@ constraint allows any number of
-- 'Inactive' @Location@s to be @current@.  However, there may be
-- at most one @current@ @Location@ per user (i.e., either zero
-- or one per user).
--
-- This data type works because of the way that SQL treats
-- @NULL@able fields within uniqueness constraints.  The SQL
-- standard says that @NULL@ values should be considered
-- different, so we represent 'Inactive' as SQL @NULL@, thus
-- allowing any number of 'Inactive' records.  On the other hand,
-- we represent 'Active' as @TRUE@, so the uniqueness constraint
-- will disallow more than one 'Active' record.
--
-- /Note:/ There may be DBMSs that do not respect the SQL
-- standard's treatment of @NULL@ values on uniqueness
-- constraints, please check if this data type works before
-- relying on it.
--
-- The SQL @BOOLEAN@ type is used because it's the smallest data
-- type available.  Note that we never use @FALSE@, just @TRUE@
-- and @NULL@.  Provides the same behavior @Maybe ()@ would if
-- @()@ was a valid 'PersistField'.
data Checkmark = Active
                 -- ^ When used on a uniqueness constraint, there
                 -- may be at most one 'Active' record.
               | Inactive
                 -- ^ When used on a uniqueness constraint, there
                 -- may be any number of 'Inactive' records.
    deriving (Checkmark -> Checkmark -> Bool
(Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Bool) -> Eq Checkmark
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Checkmark -> Checkmark -> Bool
$c/= :: Checkmark -> Checkmark -> Bool
== :: Checkmark -> Checkmark -> Bool
$c== :: Checkmark -> Checkmark -> Bool
Eq, Eq Checkmark
Eq Checkmark
-> (Checkmark -> Checkmark -> Ordering)
-> (Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Bool)
-> (Checkmark -> Checkmark -> Checkmark)
-> (Checkmark -> Checkmark -> Checkmark)
-> Ord Checkmark
Checkmark -> Checkmark -> Bool
Checkmark -> Checkmark -> Ordering
Checkmark -> Checkmark -> Checkmark
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Checkmark -> Checkmark -> Checkmark
$cmin :: Checkmark -> Checkmark -> Checkmark
max :: Checkmark -> Checkmark -> Checkmark
$cmax :: Checkmark -> Checkmark -> Checkmark
>= :: Checkmark -> Checkmark -> Bool
$c>= :: Checkmark -> Checkmark -> Bool
> :: Checkmark -> Checkmark -> Bool
$c> :: Checkmark -> Checkmark -> Bool
<= :: Checkmark -> Checkmark -> Bool
$c<= :: Checkmark -> Checkmark -> Bool
< :: Checkmark -> Checkmark -> Bool
$c< :: Checkmark -> Checkmark -> Bool
compare :: Checkmark -> Checkmark -> Ordering
$ccompare :: Checkmark -> Checkmark -> Ordering
$cp1Ord :: Eq Checkmark
Ord, ReadPrec [Checkmark]
ReadPrec Checkmark
Int -> ReadS Checkmark
ReadS [Checkmark]
(Int -> ReadS Checkmark)
-> ReadS [Checkmark]
-> ReadPrec Checkmark
-> ReadPrec [Checkmark]
-> Read Checkmark
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Checkmark]
$creadListPrec :: ReadPrec [Checkmark]
readPrec :: ReadPrec Checkmark
$creadPrec :: ReadPrec Checkmark
readList :: ReadS [Checkmark]
$creadList :: ReadS [Checkmark]
readsPrec :: Int -> ReadS Checkmark
$creadsPrec :: Int -> ReadS Checkmark
Read, Int -> Checkmark -> ShowS
[Checkmark] -> ShowS
Checkmark -> String
(Int -> Checkmark -> ShowS)
-> (Checkmark -> String)
-> ([Checkmark] -> ShowS)
-> Show Checkmark
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Checkmark] -> ShowS
$cshowList :: [Checkmark] -> ShowS
show :: Checkmark -> String
$cshow :: Checkmark -> String
showsPrec :: Int -> Checkmark -> ShowS
$cshowsPrec :: Int -> Checkmark -> ShowS
Show, Int -> Checkmark
Checkmark -> Int
Checkmark -> [Checkmark]
Checkmark -> Checkmark
Checkmark -> Checkmark -> [Checkmark]
Checkmark -> Checkmark -> Checkmark -> [Checkmark]
(Checkmark -> Checkmark)
-> (Checkmark -> Checkmark)
-> (Int -> Checkmark)
-> (Checkmark -> Int)
-> (Checkmark -> [Checkmark])
-> (Checkmark -> Checkmark -> [Checkmark])
-> (Checkmark -> Checkmark -> [Checkmark])
-> (Checkmark -> Checkmark -> Checkmark -> [Checkmark])
-> Enum Checkmark
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Checkmark -> Checkmark -> Checkmark -> [Checkmark]
$cenumFromThenTo :: Checkmark -> Checkmark -> Checkmark -> [Checkmark]
enumFromTo :: Checkmark -> Checkmark -> [Checkmark]
$cenumFromTo :: Checkmark -> Checkmark -> [Checkmark]
enumFromThen :: Checkmark -> Checkmark -> [Checkmark]
$cenumFromThen :: Checkmark -> Checkmark -> [Checkmark]
enumFrom :: Checkmark -> [Checkmark]
$cenumFrom :: Checkmark -> [Checkmark]
fromEnum :: Checkmark -> Int
$cfromEnum :: Checkmark -> Int
toEnum :: Int -> Checkmark
$ctoEnum :: Int -> Checkmark
pred :: Checkmark -> Checkmark
$cpred :: Checkmark -> Checkmark
succ :: Checkmark -> Checkmark
$csucc :: Checkmark -> Checkmark
Enum, Checkmark
Checkmark -> Checkmark -> Bounded Checkmark
forall a. a -> a -> Bounded a
maxBound :: Checkmark
$cmaxBound :: Checkmark
minBound :: Checkmark
$cminBound :: Checkmark
Bounded)

instance ToHttpApiData Checkmark where
    toUrlPiece :: Checkmark -> Text
toUrlPiece = Checkmark -> Text
forall a. Show a => a -> Text
showTextData

instance FromHttpApiData Checkmark where
    parseUrlPiece :: Text -> Either Text Checkmark
parseUrlPiece = Text -> Either Text Checkmark
forall a. (Show a, Bounded a, Enum a) => Text -> Either Text a
parseBoundedTextData

instance PathPiece Checkmark where
  toPathPiece :: Checkmark -> Text
toPathPiece Checkmark
Active = Text
"active"
  toPathPiece Checkmark
Inactive = Text
"inactive"

  fromPathPiece :: Text -> Maybe Checkmark
fromPathPiece Text
"active" = Checkmark -> Maybe Checkmark
forall a. a -> Maybe a
Just Checkmark
Active
  fromPathPiece Text
"inactive" = Checkmark -> Maybe Checkmark
forall a. a -> Maybe a
Just Checkmark
Inactive
  fromPathPiece Text
_ = Maybe Checkmark
forall a. Maybe a
Nothing

data IsNullable
    = Nullable !WhyNullable
    | NotNullable
    deriving (IsNullable -> IsNullable -> Bool
(IsNullable -> IsNullable -> Bool)
-> (IsNullable -> IsNullable -> Bool) -> Eq IsNullable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IsNullable -> IsNullable -> Bool
$c/= :: IsNullable -> IsNullable -> Bool
== :: IsNullable -> IsNullable -> Bool
$c== :: IsNullable -> IsNullable -> Bool
Eq, Int -> IsNullable -> ShowS
[IsNullable] -> ShowS
IsNullable -> String
(Int -> IsNullable -> ShowS)
-> (IsNullable -> String)
-> ([IsNullable] -> ShowS)
-> Show IsNullable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IsNullable] -> ShowS
$cshowList :: [IsNullable] -> ShowS
show :: IsNullable -> String
$cshow :: IsNullable -> String
showsPrec :: Int -> IsNullable -> ShowS
$cshowsPrec :: Int -> IsNullable -> ShowS
Show)

fieldAttrsContainsNullable :: [FieldAttr] -> IsNullable
fieldAttrsContainsNullable :: [FieldAttr] -> IsNullable
fieldAttrsContainsNullable [FieldAttr]
s
    | FieldAttr
FieldAttrMaybe    FieldAttr -> [FieldAttr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FieldAttr]
s = WhyNullable -> IsNullable
Nullable WhyNullable
ByMaybeAttr
    | FieldAttr
FieldAttrNullable FieldAttr -> [FieldAttr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FieldAttr]
s = WhyNullable -> IsNullable
Nullable WhyNullable
ByNullableAttr
    | Bool
otherwise = IsNullable
NotNullable

-- | The reason why a field is 'nullable' is very important.  A
-- field that is nullable because of a @Maybe@ tag will have its
-- type changed from @A@ to @Maybe A@.  OTOH, a field that is
-- nullable because of a @nullable@ tag will remain with the same
-- type.
data WhyNullable = ByMaybeAttr
                 | ByNullableAttr
                  deriving (WhyNullable -> WhyNullable -> Bool
(WhyNullable -> WhyNullable -> Bool)
-> (WhyNullable -> WhyNullable -> Bool) -> Eq WhyNullable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WhyNullable -> WhyNullable -> Bool
$c/= :: WhyNullable -> WhyNullable -> Bool
== :: WhyNullable -> WhyNullable -> Bool
$c== :: WhyNullable -> WhyNullable -> Bool
Eq, Int -> WhyNullable -> ShowS
[WhyNullable] -> ShowS
WhyNullable -> String
(Int -> WhyNullable -> ShowS)
-> (WhyNullable -> String)
-> ([WhyNullable] -> ShowS)
-> Show WhyNullable
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WhyNullable] -> ShowS
$cshowList :: [WhyNullable] -> ShowS
show :: WhyNullable -> String
$cshow :: WhyNullable -> String
showsPrec :: Int -> WhyNullable -> ShowS
$cshowsPrec :: Int -> WhyNullable -> ShowS
Show)

-- | An 'EntityDef' represents the information that @persistent@ knows
-- about an Entity. It uses this information to generate the Haskell
-- datatype, the SQL migrations, and other relevant conversions.
data EntityDef = EntityDef
    { EntityDef -> EntityNameHS
entityHaskell :: !EntityNameHS
    -- ^ The name of the entity as Haskell understands it.
    , EntityDef -> EntityNameDB
entityDB      :: !EntityNameDB
    -- ^ The name of the database table corresponding to the entity.
    , EntityDef -> EntityIdDef
entityId      :: !EntityIdDef
    -- ^ The entity's primary key or identifier.
    , EntityDef -> [Text]
entityAttrs   :: ![Attr]
    -- ^ The @persistent@ entity syntax allows you to add arbitrary 'Attr's
    -- to an entity using the @!@ operator. Those attributes are stored in
    -- this list.
    , EntityDef -> [FieldDef]
entityFields  :: ![FieldDef]
    -- ^ The fields for this entity. Note that the ID field will not be
    -- present in this list. To get all of the fields for an entity, use
    -- 'keyAndEntityFields'.
    , EntityDef -> [UniqueDef]
entityUniques :: ![UniqueDef]
    -- ^ The Uniqueness constraints for this entity.
    , EntityDef -> [ForeignDef]
entityForeigns:: ![ForeignDef]
    -- ^ The foreign key relationships that this entity has to other
    -- entities.
    , EntityDef -> [Text]
entityDerives :: ![Text]
    -- ^ A list of type classes that have been derived for this entity.
    , EntityDef -> Map Text [[Text]]
entityExtra   :: !(Map Text [ExtraLine])
    , EntityDef -> Bool
entitySum     :: !Bool
    -- ^ Whether or not this entity represents a sum type in the database.
    , EntityDef -> Maybe Text
entityComments :: !(Maybe Text)
    -- ^ Optional comments on the entity.
    --
    -- @since 2.10.0
    }
    deriving (Int -> EntityDef -> ShowS
[EntityDef] -> ShowS
EntityDef -> String
(Int -> EntityDef -> ShowS)
-> (EntityDef -> String)
-> ([EntityDef] -> ShowS)
-> Show EntityDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityDef] -> ShowS
$cshowList :: [EntityDef] -> ShowS
show :: EntityDef -> String
$cshow :: EntityDef -> String
showsPrec :: Int -> EntityDef -> ShowS
$cshowsPrec :: Int -> EntityDef -> ShowS
Show, EntityDef -> EntityDef -> Bool
(EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool) -> Eq EntityDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityDef -> EntityDef -> Bool
$c/= :: EntityDef -> EntityDef -> Bool
== :: EntityDef -> EntityDef -> Bool
$c== :: EntityDef -> EntityDef -> Bool
Eq, ReadPrec [EntityDef]
ReadPrec EntityDef
Int -> ReadS EntityDef
ReadS [EntityDef]
(Int -> ReadS EntityDef)
-> ReadS [EntityDef]
-> ReadPrec EntityDef
-> ReadPrec [EntityDef]
-> Read EntityDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EntityDef]
$creadListPrec :: ReadPrec [EntityDef]
readPrec :: ReadPrec EntityDef
$creadPrec :: ReadPrec EntityDef
readList :: ReadS [EntityDef]
$creadList :: ReadS [EntityDef]
readsPrec :: Int -> ReadS EntityDef
$creadsPrec :: Int -> ReadS EntityDef
Read, Eq EntityDef
Eq EntityDef
-> (EntityDef -> EntityDef -> Ordering)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> Bool)
-> (EntityDef -> EntityDef -> EntityDef)
-> (EntityDef -> EntityDef -> EntityDef)
-> Ord EntityDef
EntityDef -> EntityDef -> Bool
EntityDef -> EntityDef -> Ordering
EntityDef -> EntityDef -> EntityDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EntityDef -> EntityDef -> EntityDef
$cmin :: EntityDef -> EntityDef -> EntityDef
max :: EntityDef -> EntityDef -> EntityDef
$cmax :: EntityDef -> EntityDef -> EntityDef
>= :: EntityDef -> EntityDef -> Bool
$c>= :: EntityDef -> EntityDef -> Bool
> :: EntityDef -> EntityDef -> Bool
$c> :: EntityDef -> EntityDef -> Bool
<= :: EntityDef -> EntityDef -> Bool
$c<= :: EntityDef -> EntityDef -> Bool
< :: EntityDef -> EntityDef -> Bool
$c< :: EntityDef -> EntityDef -> Bool
compare :: EntityDef -> EntityDef -> Ordering
$ccompare :: EntityDef -> EntityDef -> Ordering
$cp1Ord :: Eq EntityDef
Ord, EntityDef -> Q Exp
EntityDef -> Q (TExp EntityDef)
(EntityDef -> Q Exp)
-> (EntityDef -> Q (TExp EntityDef)) -> Lift EntityDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: EntityDef -> Q (TExp EntityDef)
$cliftTyped :: EntityDef -> Q (TExp EntityDef)
lift :: EntityDef -> Q Exp
$clift :: EntityDef -> Q Exp
Lift)

-- | The definition for the entity's primary key ID.
--
-- @since 2.13.0.0
data EntityIdDef
    = EntityIdField !FieldDef
    -- ^ The entity has a single key column, and it is a surrogate key - that
    -- is, you can't go from @rec -> Key rec@.
    --
    -- @since 2.13.0.0
    | EntityIdNaturalKey !CompositeDef
    -- ^ The entity has a natural key. This means you can write @rec -> Key rec@
    -- because all the key fields are present on the datatype.
    --
    -- A natural key can have one or more columns.
    --
    -- @since 2.13.0.0
    deriving (Int -> EntityIdDef -> ShowS
[EntityIdDef] -> ShowS
EntityIdDef -> String
(Int -> EntityIdDef -> ShowS)
-> (EntityIdDef -> String)
-> ([EntityIdDef] -> ShowS)
-> Show EntityIdDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EntityIdDef] -> ShowS
$cshowList :: [EntityIdDef] -> ShowS
show :: EntityIdDef -> String
$cshow :: EntityIdDef -> String
showsPrec :: Int -> EntityIdDef -> ShowS
$cshowsPrec :: Int -> EntityIdDef -> ShowS
Show, EntityIdDef -> EntityIdDef -> Bool
(EntityIdDef -> EntityIdDef -> Bool)
-> (EntityIdDef -> EntityIdDef -> Bool) -> Eq EntityIdDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EntityIdDef -> EntityIdDef -> Bool
$c/= :: EntityIdDef -> EntityIdDef -> Bool
== :: EntityIdDef -> EntityIdDef -> Bool
$c== :: EntityIdDef -> EntityIdDef -> Bool
Eq, ReadPrec [EntityIdDef]
ReadPrec EntityIdDef
Int -> ReadS EntityIdDef
ReadS [EntityIdDef]
(Int -> ReadS EntityIdDef)
-> ReadS [EntityIdDef]
-> ReadPrec EntityIdDef
-> ReadPrec [EntityIdDef]
-> Read EntityIdDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EntityIdDef]
$creadListPrec :: ReadPrec [EntityIdDef]
readPrec :: ReadPrec EntityIdDef
$creadPrec :: ReadPrec EntityIdDef
readList :: ReadS [EntityIdDef]
$creadList :: ReadS [EntityIdDef]
readsPrec :: Int -> ReadS EntityIdDef
$creadsPrec :: Int -> ReadS EntityIdDef
Read, Eq EntityIdDef
Eq EntityIdDef
-> (EntityIdDef -> EntityIdDef -> Ordering)
-> (EntityIdDef -> EntityIdDef -> Bool)
-> (EntityIdDef -> EntityIdDef -> Bool)
-> (EntityIdDef -> EntityIdDef -> Bool)
-> (EntityIdDef -> EntityIdDef -> Bool)
-> (EntityIdDef -> EntityIdDef -> EntityIdDef)
-> (EntityIdDef -> EntityIdDef -> EntityIdDef)
-> Ord EntityIdDef
EntityIdDef -> EntityIdDef -> Bool
EntityIdDef -> EntityIdDef -> Ordering
EntityIdDef -> EntityIdDef -> EntityIdDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EntityIdDef -> EntityIdDef -> EntityIdDef
$cmin :: EntityIdDef -> EntityIdDef -> EntityIdDef
max :: EntityIdDef -> EntityIdDef -> EntityIdDef
$cmax :: EntityIdDef -> EntityIdDef -> EntityIdDef
>= :: EntityIdDef -> EntityIdDef -> Bool
$c>= :: EntityIdDef -> EntityIdDef -> Bool
> :: EntityIdDef -> EntityIdDef -> Bool
$c> :: EntityIdDef -> EntityIdDef -> Bool
<= :: EntityIdDef -> EntityIdDef -> Bool
$c<= :: EntityIdDef -> EntityIdDef -> Bool
< :: EntityIdDef -> EntityIdDef -> Bool
$c< :: EntityIdDef -> EntityIdDef -> Bool
compare :: EntityIdDef -> EntityIdDef -> Ordering
$ccompare :: EntityIdDef -> EntityIdDef -> Ordering
$cp1Ord :: Eq EntityIdDef
Ord, EntityIdDef -> Q Exp
EntityIdDef -> Q (TExp EntityIdDef)
(EntityIdDef -> Q Exp)
-> (EntityIdDef -> Q (TExp EntityIdDef)) -> Lift EntityIdDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: EntityIdDef -> Q (TExp EntityIdDef)
$cliftTyped :: EntityIdDef -> Q (TExp EntityIdDef)
lift :: EntityIdDef -> Q Exp
$clift :: EntityIdDef -> Q Exp
Lift)

-- | Return the @['FieldDef']@ for the entity keys.
entitiesPrimary :: EntityDef -> NonEmpty FieldDef
entitiesPrimary :: EntityDef -> NonEmpty FieldDef
entitiesPrimary EntityDef
t =
    case EntityDef -> EntityIdDef
entityId EntityDef
t of
        EntityIdNaturalKey CompositeDef
fds ->
            CompositeDef -> NonEmpty FieldDef
compositeFields CompositeDef
fds
        EntityIdField FieldDef
fd ->
            FieldDef -> NonEmpty FieldDef
forall (f :: * -> *) a. Applicative f => a -> f a
pure FieldDef
fd

entityPrimary :: EntityDef -> Maybe CompositeDef
entityPrimary :: EntityDef -> Maybe CompositeDef
entityPrimary EntityDef
t =
    case EntityDef -> EntityIdDef
entityId EntityDef
t of
        EntityIdNaturalKey CompositeDef
c ->
            CompositeDef -> Maybe CompositeDef
forall a. a -> Maybe a
Just CompositeDef
c
        EntityIdDef
_ ->
            Maybe CompositeDef
forall a. Maybe a
Nothing

entityKeyFields :: EntityDef -> NonEmpty FieldDef
entityKeyFields :: EntityDef -> NonEmpty FieldDef
entityKeyFields =
    EntityDef -> NonEmpty FieldDef
entitiesPrimary

-- | Returns a 'NonEmpty' list of 'FieldDef' that correspond with the key
-- columns for an 'EntityDef'.
keyAndEntityFields :: EntityDef -> NonEmpty FieldDef
keyAndEntityFields :: EntityDef -> NonEmpty FieldDef
keyAndEntityFields EntityDef
ent =
    case EntityDef -> EntityIdDef
entityId EntityDef
ent of
        EntityIdField FieldDef
fd ->
            FieldDef
fd FieldDef -> [FieldDef] -> NonEmpty FieldDef
forall a. a -> [a] -> NonEmpty a
:| [FieldDef]
fields
        EntityIdNaturalKey CompositeDef
_ ->
            case [FieldDef] -> Maybe (NonEmpty FieldDef)
forall a. [a] -> Maybe (NonEmpty a)
NEL.nonEmpty [FieldDef]
fields of
                Maybe (NonEmpty FieldDef)
Nothing ->
                    String -> NonEmpty FieldDef
forall a. HasCallStack => String -> a
error (String -> NonEmpty FieldDef) -> String -> NonEmpty FieldDef
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall a. Monoid a => [a] -> a
mconcat
                        [ String
"persistent internal guarantee failed: entity is "
                        , String
"defined with an entityId = EntityIdNaturalKey, "
                        , String
"but somehow doesn't have any entity fields."
                        ]
                Just NonEmpty FieldDef
xs ->
                    NonEmpty FieldDef
xs
  where
    fields :: [FieldDef]
fields = (FieldDef -> Bool) -> [FieldDef] -> [FieldDef]
forall a. (a -> Bool) -> [a] -> [a]
filter FieldDef -> Bool
isHaskellField ([FieldDef] -> [FieldDef]) -> [FieldDef] -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityFields EntityDef
ent

type ExtraLine = [Text]

type Attr = Text

-- | Attributes that may be attached to fields that can affect migrations
-- and serialization in backend-specific ways.
--
-- While we endeavor to, we can't forsee all use cases for all backends,
-- and so 'FieldAttr' is extensible through its constructor 'FieldAttrOther'.
--
-- @since 2.11.0.0
data FieldAttr
    = FieldAttrMaybe
    -- ^ The 'Maybe' keyword goes after the type. This indicates that the column
    -- is nullable, and the generated Haskell code will have a @'Maybe'@ type
    -- for it.
    --
    -- Example:
    --
    -- @
    -- User
    --     name Text Maybe
    -- @
    | FieldAttrNullable
    -- ^ This indicates that the column is nullable, but should not have
    -- a 'Maybe' type. For this to work out, you need to ensure that the
    -- 'PersistField' instance for the type in question can support
    -- a 'PersistNull' value.
    --
    -- @
    -- data What = NoWhat | Hello Text
    --
    -- instance PersistField What where
    --     fromPersistValue PersistNull =
    --         pure NoWhat
    --     fromPersistValue pv =
    --         Hello <$> fromPersistValue pv
    --
    -- instance PersistFieldSql What where
    --     sqlType _ = SqlString
    --
    -- User
    --     what What nullable
    -- @
    | FieldAttrMigrationOnly
    -- ^ This tag means that the column will not be present on the Haskell code,
    -- but will not be removed from the database. Useful to deprecate fields in
    -- phases.
    --
    -- You should set the column to be nullable in the database. Otherwise,
    -- inserts won't have values.
    --
    -- @
    -- User
    --     oldName Text MigrationOnly
    --     newName Text
    -- @
    | FieldAttrSafeToRemove
    -- ^ A @SafeToRemove@ attribute is not present on the Haskell datatype, and
    -- the backend migrations should attempt to drop the column without
    -- triggering any unsafe migration warnings.
    --
    -- Useful after you've used @MigrationOnly@ to remove a column from the
    -- database in phases.
    --
    -- @
    -- User
    --     oldName Text SafeToRemove
    --     newName Text
    -- @
    | FieldAttrNoreference
    -- ^ This attribute indicates that we should create a foreign key reference
    -- from a column. By default, @persistent@ will try and create a foreign key
    -- reference for a column if it can determine that the type of the column is
    -- a @'Key' entity@ or an @EntityId@  and the @Entity@'s name was present in
    -- 'mkPersist'.
    --
    -- This is useful if you want to use the explicit foreign key syntax.
    --
    -- @
    -- Post
    --     title    Text
    --
    -- Comment
    --     postId   PostId      noreference
    --     Foreign Post fk_comment_post postId
    -- @
    | FieldAttrReference Text
    -- ^ This is set to specify precisely the database table the column refers
    -- to.
    --
    -- @
    -- Post
    --     title    Text
    --
    -- Comment
    --     postId   PostId references="post"
    -- @
    --
    -- You should not need this - @persistent@ should be capable of correctly
    -- determining the target table's name. If you do need this, please file an
    -- issue describing why.
    | FieldAttrConstraint Text
    -- ^ Specify a name for the constraint on the foreign key reference for this
    -- table.
    --
    -- @
    -- Post
    --     title    Text
    --
    -- Comment
    --     postId   PostId constraint="my_cool_constraint_name"
    -- @
    | FieldAttrDefault Text
    -- ^ Specify the default value for a column.
    --
    -- @
    -- User
    --     createdAt    UTCTime     default="NOW()"
    -- @
    --
    -- Note that a @default=@ attribute does not mean you can omit the value
    -- while inserting.
    | FieldAttrSqltype Text
    -- ^ Specify a custom SQL type for the column. Generally, you should define
    -- a custom datatype with a custom 'PersistFieldSql' instance instead of
    -- using this.
    --
    -- @
    -- User
    --     uuid     Text    sqltype="UUID"
    -- @
    | FieldAttrMaxlen Integer
    -- ^ Set a maximum length for a column. Useful for VARCHAR and indexes.
    --
    -- @
    -- User
    --     name     Text    maxlen=200
    --
    --     UniqueName name
    -- @
    | FieldAttrSql Text
    -- ^ Specify the database name of the column.
    --
    -- @
    -- User
    --     blarghle     Int     sql="b_l_a_r_g_h_l_e"
    -- @
    --
    -- Useful for performing phased migrations, where one column is renamed to
    -- another column over time.
    | FieldAttrOther Text
    -- ^ A grab bag of random attributes that were unrecognized by the parser.
    deriving (Int -> FieldAttr -> ShowS
[FieldAttr] -> ShowS
FieldAttr -> String
(Int -> FieldAttr -> ShowS)
-> (FieldAttr -> String)
-> ([FieldAttr] -> ShowS)
-> Show FieldAttr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldAttr] -> ShowS
$cshowList :: [FieldAttr] -> ShowS
show :: FieldAttr -> String
$cshow :: FieldAttr -> String
showsPrec :: Int -> FieldAttr -> ShowS
$cshowsPrec :: Int -> FieldAttr -> ShowS
Show, FieldAttr -> FieldAttr -> Bool
(FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> Bool) -> Eq FieldAttr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldAttr -> FieldAttr -> Bool
$c/= :: FieldAttr -> FieldAttr -> Bool
== :: FieldAttr -> FieldAttr -> Bool
$c== :: FieldAttr -> FieldAttr -> Bool
Eq, ReadPrec [FieldAttr]
ReadPrec FieldAttr
Int -> ReadS FieldAttr
ReadS [FieldAttr]
(Int -> ReadS FieldAttr)
-> ReadS [FieldAttr]
-> ReadPrec FieldAttr
-> ReadPrec [FieldAttr]
-> Read FieldAttr
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldAttr]
$creadListPrec :: ReadPrec [FieldAttr]
readPrec :: ReadPrec FieldAttr
$creadPrec :: ReadPrec FieldAttr
readList :: ReadS [FieldAttr]
$creadList :: ReadS [FieldAttr]
readsPrec :: Int -> ReadS FieldAttr
$creadsPrec :: Int -> ReadS FieldAttr
Read, Eq FieldAttr
Eq FieldAttr
-> (FieldAttr -> FieldAttr -> Ordering)
-> (FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> Bool)
-> (FieldAttr -> FieldAttr -> FieldAttr)
-> (FieldAttr -> FieldAttr -> FieldAttr)
-> Ord FieldAttr
FieldAttr -> FieldAttr -> Bool
FieldAttr -> FieldAttr -> Ordering
FieldAttr -> FieldAttr -> FieldAttr
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldAttr -> FieldAttr -> FieldAttr
$cmin :: FieldAttr -> FieldAttr -> FieldAttr
max :: FieldAttr -> FieldAttr -> FieldAttr
$cmax :: FieldAttr -> FieldAttr -> FieldAttr
>= :: FieldAttr -> FieldAttr -> Bool
$c>= :: FieldAttr -> FieldAttr -> Bool
> :: FieldAttr -> FieldAttr -> Bool
$c> :: FieldAttr -> FieldAttr -> Bool
<= :: FieldAttr -> FieldAttr -> Bool
$c<= :: FieldAttr -> FieldAttr -> Bool
< :: FieldAttr -> FieldAttr -> Bool
$c< :: FieldAttr -> FieldAttr -> Bool
compare :: FieldAttr -> FieldAttr -> Ordering
$ccompare :: FieldAttr -> FieldAttr -> Ordering
$cp1Ord :: Eq FieldAttr
Ord, FieldAttr -> Q Exp
FieldAttr -> Q (TExp FieldAttr)
(FieldAttr -> Q Exp)
-> (FieldAttr -> Q (TExp FieldAttr)) -> Lift FieldAttr
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FieldAttr -> Q (TExp FieldAttr)
$cliftTyped :: FieldAttr -> Q (TExp FieldAttr)
lift :: FieldAttr -> Q Exp
$clift :: FieldAttr -> Q Exp
Lift)

-- | Parse raw field attributes into structured form. Any unrecognized
-- attributes will be preserved, identically as they are encountered,
-- as 'FieldAttrOther' values.
--
-- @since 2.11.0.0
parseFieldAttrs :: [Text] -> [FieldAttr]
parseFieldAttrs :: [Text] -> [FieldAttr]
parseFieldAttrs = (Text -> FieldAttr) -> [Text] -> [FieldAttr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> FieldAttr) -> [Text] -> [FieldAttr])
-> (Text -> FieldAttr) -> [Text] -> [FieldAttr]
forall a b. (a -> b) -> a -> b
$ \case
    Text
"Maybe" -> FieldAttr
FieldAttrMaybe
    Text
"nullable" -> FieldAttr
FieldAttrNullable
    Text
"MigrationOnly" -> FieldAttr
FieldAttrMigrationOnly
    Text
"SafeToRemove" -> FieldAttr
FieldAttrSafeToRemove
    Text
"noreference" -> FieldAttr
FieldAttrNoreference
    Text
raw
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"reference=" Text
raw -> Text -> FieldAttr
FieldAttrReference Text
x
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"constraint=" Text
raw -> Text -> FieldAttr
FieldAttrConstraint Text
x
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"default=" Text
raw -> Text -> FieldAttr
FieldAttrDefault Text
x
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"sqltype=" Text
raw -> Text -> FieldAttr
FieldAttrSqltype Text
x
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"maxlen=" Text
raw -> case ReadS Integer
forall a. Read a => ReadS a
reads (Text -> String
T.unpack Text
x) of
            [(Integer
n, String
s)] | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s -> Integer -> FieldAttr
FieldAttrMaxlen Integer
n
            [(Integer, String)]
_ -> String -> FieldAttr
forall a. HasCallStack => String -> a
error (String -> FieldAttr) -> String -> FieldAttr
forall a b. (a -> b) -> a -> b
$ String
"Could not parse maxlen field with value " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
raw
        | Just Text
x <- Text -> Text -> Maybe Text
T.stripPrefix Text
"sql=" Text
raw ->
            Text -> FieldAttr
FieldAttrSql Text
x
        | Bool
otherwise -> Text -> FieldAttr
FieldAttrOther Text
raw

-- | A 'FieldType' describes a field parsed from the QuasiQuoter and is
-- used to determine the Haskell type in the generated code.
--
-- @name Text@ parses into @FTTypeCon Nothing "Text"@
--
-- @name T.Text@ parses into @FTTypeCon (Just "T" "Text")@
--
-- @name (Jsonb User)@ parses into:
--
-- @
-- FTApp (FTTypeCon Nothing "Jsonb") (FTTypeCon Nothing "User")
-- @
data FieldType
    = FTTypeCon (Maybe Text) Text
    -- ^ Optional module and name.
    | FTLit FieldTypeLit
    | FTTypePromoted Text
    | FTApp FieldType FieldType
    | FTList FieldType
    deriving (Int -> FieldType -> ShowS
[FieldType] -> ShowS
FieldType -> String
(Int -> FieldType -> ShowS)
-> (FieldType -> String)
-> ([FieldType] -> ShowS)
-> Show FieldType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldType] -> ShowS
$cshowList :: [FieldType] -> ShowS
show :: FieldType -> String
$cshow :: FieldType -> String
showsPrec :: Int -> FieldType -> ShowS
$cshowsPrec :: Int -> FieldType -> ShowS
Show, FieldType -> FieldType -> Bool
(FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool) -> Eq FieldType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldType -> FieldType -> Bool
$c/= :: FieldType -> FieldType -> Bool
== :: FieldType -> FieldType -> Bool
$c== :: FieldType -> FieldType -> Bool
Eq, ReadPrec [FieldType]
ReadPrec FieldType
Int -> ReadS FieldType
ReadS [FieldType]
(Int -> ReadS FieldType)
-> ReadS [FieldType]
-> ReadPrec FieldType
-> ReadPrec [FieldType]
-> Read FieldType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldType]
$creadListPrec :: ReadPrec [FieldType]
readPrec :: ReadPrec FieldType
$creadPrec :: ReadPrec FieldType
readList :: ReadS [FieldType]
$creadList :: ReadS [FieldType]
readsPrec :: Int -> ReadS FieldType
$creadsPrec :: Int -> ReadS FieldType
Read, Eq FieldType
Eq FieldType
-> (FieldType -> FieldType -> Ordering)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> Bool)
-> (FieldType -> FieldType -> FieldType)
-> (FieldType -> FieldType -> FieldType)
-> Ord FieldType
FieldType -> FieldType -> Bool
FieldType -> FieldType -> Ordering
FieldType -> FieldType -> FieldType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldType -> FieldType -> FieldType
$cmin :: FieldType -> FieldType -> FieldType
max :: FieldType -> FieldType -> FieldType
$cmax :: FieldType -> FieldType -> FieldType
>= :: FieldType -> FieldType -> Bool
$c>= :: FieldType -> FieldType -> Bool
> :: FieldType -> FieldType -> Bool
$c> :: FieldType -> FieldType -> Bool
<= :: FieldType -> FieldType -> Bool
$c<= :: FieldType -> FieldType -> Bool
< :: FieldType -> FieldType -> Bool
$c< :: FieldType -> FieldType -> Bool
compare :: FieldType -> FieldType -> Ordering
$ccompare :: FieldType -> FieldType -> Ordering
$cp1Ord :: Eq FieldType
Ord, FieldType -> Q Exp
FieldType -> Q (TExp FieldType)
(FieldType -> Q Exp)
-> (FieldType -> Q (TExp FieldType)) -> Lift FieldType
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FieldType -> Q (TExp FieldType)
$cliftTyped :: FieldType -> Q (TExp FieldType)
lift :: FieldType -> Q Exp
$clift :: FieldType -> Q Exp
Lift)

data FieldTypeLit
    = IntTypeLit Integer
    | TextTypeLit Text
    deriving (Int -> FieldTypeLit -> ShowS
[FieldTypeLit] -> ShowS
FieldTypeLit -> String
(Int -> FieldTypeLit -> ShowS)
-> (FieldTypeLit -> String)
-> ([FieldTypeLit] -> ShowS)
-> Show FieldTypeLit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldTypeLit] -> ShowS
$cshowList :: [FieldTypeLit] -> ShowS
show :: FieldTypeLit -> String
$cshow :: FieldTypeLit -> String
showsPrec :: Int -> FieldTypeLit -> ShowS
$cshowsPrec :: Int -> FieldTypeLit -> ShowS
Show, FieldTypeLit -> FieldTypeLit -> Bool
(FieldTypeLit -> FieldTypeLit -> Bool)
-> (FieldTypeLit -> FieldTypeLit -> Bool) -> Eq FieldTypeLit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldTypeLit -> FieldTypeLit -> Bool
$c/= :: FieldTypeLit -> FieldTypeLit -> Bool
== :: FieldTypeLit -> FieldTypeLit -> Bool
$c== :: FieldTypeLit -> FieldTypeLit -> Bool
Eq, ReadPrec [FieldTypeLit]
ReadPrec FieldTypeLit
Int -> ReadS FieldTypeLit
ReadS [FieldTypeLit]
(Int -> ReadS FieldTypeLit)
-> ReadS [FieldTypeLit]
-> ReadPrec FieldTypeLit
-> ReadPrec [FieldTypeLit]
-> Read FieldTypeLit
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldTypeLit]
$creadListPrec :: ReadPrec [FieldTypeLit]
readPrec :: ReadPrec FieldTypeLit
$creadPrec :: ReadPrec FieldTypeLit
readList :: ReadS [FieldTypeLit]
$creadList :: ReadS [FieldTypeLit]
readsPrec :: Int -> ReadS FieldTypeLit
$creadsPrec :: Int -> ReadS FieldTypeLit
Read, Eq FieldTypeLit
Eq FieldTypeLit
-> (FieldTypeLit -> FieldTypeLit -> Ordering)
-> (FieldTypeLit -> FieldTypeLit -> Bool)
-> (FieldTypeLit -> FieldTypeLit -> Bool)
-> (FieldTypeLit -> FieldTypeLit -> Bool)
-> (FieldTypeLit -> FieldTypeLit -> Bool)
-> (FieldTypeLit -> FieldTypeLit -> FieldTypeLit)
-> (FieldTypeLit -> FieldTypeLit -> FieldTypeLit)
-> Ord FieldTypeLit
FieldTypeLit -> FieldTypeLit -> Bool
FieldTypeLit -> FieldTypeLit -> Ordering
FieldTypeLit -> FieldTypeLit -> FieldTypeLit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldTypeLit -> FieldTypeLit -> FieldTypeLit
$cmin :: FieldTypeLit -> FieldTypeLit -> FieldTypeLit
max :: FieldTypeLit -> FieldTypeLit -> FieldTypeLit
$cmax :: FieldTypeLit -> FieldTypeLit -> FieldTypeLit
>= :: FieldTypeLit -> FieldTypeLit -> Bool
$c>= :: FieldTypeLit -> FieldTypeLit -> Bool
> :: FieldTypeLit -> FieldTypeLit -> Bool
$c> :: FieldTypeLit -> FieldTypeLit -> Bool
<= :: FieldTypeLit -> FieldTypeLit -> Bool
$c<= :: FieldTypeLit -> FieldTypeLit -> Bool
< :: FieldTypeLit -> FieldTypeLit -> Bool
$c< :: FieldTypeLit -> FieldTypeLit -> Bool
compare :: FieldTypeLit -> FieldTypeLit -> Ordering
$ccompare :: FieldTypeLit -> FieldTypeLit -> Ordering
$cp1Ord :: Eq FieldTypeLit
Ord, FieldTypeLit -> Q Exp
FieldTypeLit -> Q (TExp FieldTypeLit)
(FieldTypeLit -> Q Exp)
-> (FieldTypeLit -> Q (TExp FieldTypeLit)) -> Lift FieldTypeLit
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FieldTypeLit -> Q (TExp FieldTypeLit)
$cliftTyped :: FieldTypeLit -> Q (TExp FieldTypeLit)
lift :: FieldTypeLit -> Q Exp
$clift :: FieldTypeLit -> Q Exp
Lift)

isFieldNotGenerated :: FieldDef -> Bool
isFieldNotGenerated :: FieldDef -> Bool
isFieldNotGenerated = Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Text -> Bool)
-> (FieldDef -> Maybe Text) -> FieldDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDef -> Maybe Text
fieldGenerated

-- | There are 3 kinds of references
-- 1) composite (to fields that exist in the record)
-- 2) single field
-- 3) embedded
data ReferenceDef
    = NoReference
    | ForeignRef !EntityNameHS
    -- ^ A ForeignRef has a late binding to the EntityDef it references via name
    -- and has the Haskell type of the foreign key in the form of FieldType
    | EmbedRef EntityNameHS
    | SelfReference
    -- ^ A SelfReference stops an immediate cycle which causes non-termination at compile-time (issue #311).
    deriving (Int -> ReferenceDef -> ShowS
[ReferenceDef] -> ShowS
ReferenceDef -> String
(Int -> ReferenceDef -> ShowS)
-> (ReferenceDef -> String)
-> ([ReferenceDef] -> ShowS)
-> Show ReferenceDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceDef] -> ShowS
$cshowList :: [ReferenceDef] -> ShowS
show :: ReferenceDef -> String
$cshow :: ReferenceDef -> String
showsPrec :: Int -> ReferenceDef -> ShowS
$cshowsPrec :: Int -> ReferenceDef -> ShowS
Show, ReferenceDef -> ReferenceDef -> Bool
(ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> Bool) -> Eq ReferenceDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceDef -> ReferenceDef -> Bool
$c/= :: ReferenceDef -> ReferenceDef -> Bool
== :: ReferenceDef -> ReferenceDef -> Bool
$c== :: ReferenceDef -> ReferenceDef -> Bool
Eq, ReadPrec [ReferenceDef]
ReadPrec ReferenceDef
Int -> ReadS ReferenceDef
ReadS [ReferenceDef]
(Int -> ReadS ReferenceDef)
-> ReadS [ReferenceDef]
-> ReadPrec ReferenceDef
-> ReadPrec [ReferenceDef]
-> Read ReferenceDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReferenceDef]
$creadListPrec :: ReadPrec [ReferenceDef]
readPrec :: ReadPrec ReferenceDef
$creadPrec :: ReadPrec ReferenceDef
readList :: ReadS [ReferenceDef]
$creadList :: ReadS [ReferenceDef]
readsPrec :: Int -> ReadS ReferenceDef
$creadsPrec :: Int -> ReadS ReferenceDef
Read, Eq ReferenceDef
Eq ReferenceDef
-> (ReferenceDef -> ReferenceDef -> Ordering)
-> (ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> Bool)
-> (ReferenceDef -> ReferenceDef -> ReferenceDef)
-> (ReferenceDef -> ReferenceDef -> ReferenceDef)
-> Ord ReferenceDef
ReferenceDef -> ReferenceDef -> Bool
ReferenceDef -> ReferenceDef -> Ordering
ReferenceDef -> ReferenceDef -> ReferenceDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReferenceDef -> ReferenceDef -> ReferenceDef
$cmin :: ReferenceDef -> ReferenceDef -> ReferenceDef
max :: ReferenceDef -> ReferenceDef -> ReferenceDef
$cmax :: ReferenceDef -> ReferenceDef -> ReferenceDef
>= :: ReferenceDef -> ReferenceDef -> Bool
$c>= :: ReferenceDef -> ReferenceDef -> Bool
> :: ReferenceDef -> ReferenceDef -> Bool
$c> :: ReferenceDef -> ReferenceDef -> Bool
<= :: ReferenceDef -> ReferenceDef -> Bool
$c<= :: ReferenceDef -> ReferenceDef -> Bool
< :: ReferenceDef -> ReferenceDef -> Bool
$c< :: ReferenceDef -> ReferenceDef -> Bool
compare :: ReferenceDef -> ReferenceDef -> Ordering
$ccompare :: ReferenceDef -> ReferenceDef -> Ordering
$cp1Ord :: Eq ReferenceDef
Ord, ReferenceDef -> Q Exp
ReferenceDef -> Q (TExp ReferenceDef)
(ReferenceDef -> Q Exp)
-> (ReferenceDef -> Q (TExp ReferenceDef)) -> Lift ReferenceDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ReferenceDef -> Q (TExp ReferenceDef)
$cliftTyped :: ReferenceDef -> Q (TExp ReferenceDef)
lift :: ReferenceDef -> Q Exp
$clift :: ReferenceDef -> Q Exp
Lift)

-- | An EmbedEntityDef is the same as an EntityDef
-- But it is only used for fieldReference
-- so it only has data needed for embedding
data EmbedEntityDef = EmbedEntityDef
    { EmbedEntityDef -> EntityNameHS
embeddedHaskell :: EntityNameHS
    , EmbedEntityDef -> [EmbedFieldDef]
embeddedFields  :: [EmbedFieldDef]
    } deriving (Int -> EmbedEntityDef -> ShowS
[EmbedEntityDef] -> ShowS
EmbedEntityDef -> String
(Int -> EmbedEntityDef -> ShowS)
-> (EmbedEntityDef -> String)
-> ([EmbedEntityDef] -> ShowS)
-> Show EmbedEntityDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmbedEntityDef] -> ShowS
$cshowList :: [EmbedEntityDef] -> ShowS
show :: EmbedEntityDef -> String
$cshow :: EmbedEntityDef -> String
showsPrec :: Int -> EmbedEntityDef -> ShowS
$cshowsPrec :: Int -> EmbedEntityDef -> ShowS
Show, EmbedEntityDef -> EmbedEntityDef -> Bool
(EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool) -> Eq EmbedEntityDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c/= :: EmbedEntityDef -> EmbedEntityDef -> Bool
== :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c== :: EmbedEntityDef -> EmbedEntityDef -> Bool
Eq, ReadPrec [EmbedEntityDef]
ReadPrec EmbedEntityDef
Int -> ReadS EmbedEntityDef
ReadS [EmbedEntityDef]
(Int -> ReadS EmbedEntityDef)
-> ReadS [EmbedEntityDef]
-> ReadPrec EmbedEntityDef
-> ReadPrec [EmbedEntityDef]
-> Read EmbedEntityDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmbedEntityDef]
$creadListPrec :: ReadPrec [EmbedEntityDef]
readPrec :: ReadPrec EmbedEntityDef
$creadPrec :: ReadPrec EmbedEntityDef
readList :: ReadS [EmbedEntityDef]
$creadList :: ReadS [EmbedEntityDef]
readsPrec :: Int -> ReadS EmbedEntityDef
$creadsPrec :: Int -> ReadS EmbedEntityDef
Read, Eq EmbedEntityDef
Eq EmbedEntityDef
-> (EmbedEntityDef -> EmbedEntityDef -> Ordering)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> Bool)
-> (EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef)
-> (EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef)
-> Ord EmbedEntityDef
EmbedEntityDef -> EmbedEntityDef -> Bool
EmbedEntityDef -> EmbedEntityDef -> Ordering
EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
$cmin :: EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
max :: EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
$cmax :: EmbedEntityDef -> EmbedEntityDef -> EmbedEntityDef
>= :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c>= :: EmbedEntityDef -> EmbedEntityDef -> Bool
> :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c> :: EmbedEntityDef -> EmbedEntityDef -> Bool
<= :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c<= :: EmbedEntityDef -> EmbedEntityDef -> Bool
< :: EmbedEntityDef -> EmbedEntityDef -> Bool
$c< :: EmbedEntityDef -> EmbedEntityDef -> Bool
compare :: EmbedEntityDef -> EmbedEntityDef -> Ordering
$ccompare :: EmbedEntityDef -> EmbedEntityDef -> Ordering
$cp1Ord :: Eq EmbedEntityDef
Ord, EmbedEntityDef -> Q Exp
EmbedEntityDef -> Q (TExp EmbedEntityDef)
(EmbedEntityDef -> Q Exp)
-> (EmbedEntityDef -> Q (TExp EmbedEntityDef))
-> Lift EmbedEntityDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: EmbedEntityDef -> Q (TExp EmbedEntityDef)
$cliftTyped :: EmbedEntityDef -> Q (TExp EmbedEntityDef)
lift :: EmbedEntityDef -> Q Exp
$clift :: EmbedEntityDef -> Q Exp
Lift)

-- | An EmbedFieldDef is the same as a FieldDef
-- But it is only used for embeddedFields
-- so it only has data needed for embedding
data EmbedFieldDef = EmbedFieldDef
    { EmbedFieldDef -> FieldNameDB
emFieldDB    :: FieldNameDB
    , EmbedFieldDef -> Maybe (Either SelfEmbed EntityNameHS)
emFieldEmbed :: Maybe (Either SelfEmbed EntityNameHS)
    }
    deriving (Int -> EmbedFieldDef -> ShowS
[EmbedFieldDef] -> ShowS
EmbedFieldDef -> String
(Int -> EmbedFieldDef -> ShowS)
-> (EmbedFieldDef -> String)
-> ([EmbedFieldDef] -> ShowS)
-> Show EmbedFieldDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EmbedFieldDef] -> ShowS
$cshowList :: [EmbedFieldDef] -> ShowS
show :: EmbedFieldDef -> String
$cshow :: EmbedFieldDef -> String
showsPrec :: Int -> EmbedFieldDef -> ShowS
$cshowsPrec :: Int -> EmbedFieldDef -> ShowS
Show, EmbedFieldDef -> EmbedFieldDef -> Bool
(EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool) -> Eq EmbedFieldDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c/= :: EmbedFieldDef -> EmbedFieldDef -> Bool
== :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c== :: EmbedFieldDef -> EmbedFieldDef -> Bool
Eq, ReadPrec [EmbedFieldDef]
ReadPrec EmbedFieldDef
Int -> ReadS EmbedFieldDef
ReadS [EmbedFieldDef]
(Int -> ReadS EmbedFieldDef)
-> ReadS [EmbedFieldDef]
-> ReadPrec EmbedFieldDef
-> ReadPrec [EmbedFieldDef]
-> Read EmbedFieldDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EmbedFieldDef]
$creadListPrec :: ReadPrec [EmbedFieldDef]
readPrec :: ReadPrec EmbedFieldDef
$creadPrec :: ReadPrec EmbedFieldDef
readList :: ReadS [EmbedFieldDef]
$creadList :: ReadS [EmbedFieldDef]
readsPrec :: Int -> ReadS EmbedFieldDef
$creadsPrec :: Int -> ReadS EmbedFieldDef
Read, Eq EmbedFieldDef
Eq EmbedFieldDef
-> (EmbedFieldDef -> EmbedFieldDef -> Ordering)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> Bool)
-> (EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef)
-> (EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef)
-> Ord EmbedFieldDef
EmbedFieldDef -> EmbedFieldDef -> Bool
EmbedFieldDef -> EmbedFieldDef -> Ordering
EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
$cmin :: EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
max :: EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
$cmax :: EmbedFieldDef -> EmbedFieldDef -> EmbedFieldDef
>= :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c>= :: EmbedFieldDef -> EmbedFieldDef -> Bool
> :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c> :: EmbedFieldDef -> EmbedFieldDef -> Bool
<= :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c<= :: EmbedFieldDef -> EmbedFieldDef -> Bool
< :: EmbedFieldDef -> EmbedFieldDef -> Bool
$c< :: EmbedFieldDef -> EmbedFieldDef -> Bool
compare :: EmbedFieldDef -> EmbedFieldDef -> Ordering
$ccompare :: EmbedFieldDef -> EmbedFieldDef -> Ordering
$cp1Ord :: Eq EmbedFieldDef
Ord, EmbedFieldDef -> Q Exp
EmbedFieldDef -> Q (TExp EmbedFieldDef)
(EmbedFieldDef -> Q Exp)
-> (EmbedFieldDef -> Q (TExp EmbedFieldDef)) -> Lift EmbedFieldDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: EmbedFieldDef -> Q (TExp EmbedFieldDef)
$cliftTyped :: EmbedFieldDef -> Q (TExp EmbedFieldDef)
lift :: EmbedFieldDef -> Q Exp
$clift :: EmbedFieldDef -> Q Exp
Lift)

data SelfEmbed = SelfEmbed
    deriving (Int -> SelfEmbed -> ShowS
[SelfEmbed] -> ShowS
SelfEmbed -> String
(Int -> SelfEmbed -> ShowS)
-> (SelfEmbed -> String)
-> ([SelfEmbed] -> ShowS)
-> Show SelfEmbed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SelfEmbed] -> ShowS
$cshowList :: [SelfEmbed] -> ShowS
show :: SelfEmbed -> String
$cshow :: SelfEmbed -> String
showsPrec :: Int -> SelfEmbed -> ShowS
$cshowsPrec :: Int -> SelfEmbed -> ShowS
Show, SelfEmbed -> SelfEmbed -> Bool
(SelfEmbed -> SelfEmbed -> Bool)
-> (SelfEmbed -> SelfEmbed -> Bool) -> Eq SelfEmbed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SelfEmbed -> SelfEmbed -> Bool
$c/= :: SelfEmbed -> SelfEmbed -> Bool
== :: SelfEmbed -> SelfEmbed -> Bool
$c== :: SelfEmbed -> SelfEmbed -> Bool
Eq, ReadPrec [SelfEmbed]
ReadPrec SelfEmbed
Int -> ReadS SelfEmbed
ReadS [SelfEmbed]
(Int -> ReadS SelfEmbed)
-> ReadS [SelfEmbed]
-> ReadPrec SelfEmbed
-> ReadPrec [SelfEmbed]
-> Read SelfEmbed
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SelfEmbed]
$creadListPrec :: ReadPrec [SelfEmbed]
readPrec :: ReadPrec SelfEmbed
$creadPrec :: ReadPrec SelfEmbed
readList :: ReadS [SelfEmbed]
$creadList :: ReadS [SelfEmbed]
readsPrec :: Int -> ReadS SelfEmbed
$creadsPrec :: Int -> ReadS SelfEmbed
Read, Eq SelfEmbed
Eq SelfEmbed
-> (SelfEmbed -> SelfEmbed -> Ordering)
-> (SelfEmbed -> SelfEmbed -> Bool)
-> (SelfEmbed -> SelfEmbed -> Bool)
-> (SelfEmbed -> SelfEmbed -> Bool)
-> (SelfEmbed -> SelfEmbed -> Bool)
-> (SelfEmbed -> SelfEmbed -> SelfEmbed)
-> (SelfEmbed -> SelfEmbed -> SelfEmbed)
-> Ord SelfEmbed
SelfEmbed -> SelfEmbed -> Bool
SelfEmbed -> SelfEmbed -> Ordering
SelfEmbed -> SelfEmbed -> SelfEmbed
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SelfEmbed -> SelfEmbed -> SelfEmbed
$cmin :: SelfEmbed -> SelfEmbed -> SelfEmbed
max :: SelfEmbed -> SelfEmbed -> SelfEmbed
$cmax :: SelfEmbed -> SelfEmbed -> SelfEmbed
>= :: SelfEmbed -> SelfEmbed -> Bool
$c>= :: SelfEmbed -> SelfEmbed -> Bool
> :: SelfEmbed -> SelfEmbed -> Bool
$c> :: SelfEmbed -> SelfEmbed -> Bool
<= :: SelfEmbed -> SelfEmbed -> Bool
$c<= :: SelfEmbed -> SelfEmbed -> Bool
< :: SelfEmbed -> SelfEmbed -> Bool
$c< :: SelfEmbed -> SelfEmbed -> Bool
compare :: SelfEmbed -> SelfEmbed -> Ordering
$ccompare :: SelfEmbed -> SelfEmbed -> Ordering
$cp1Ord :: Eq SelfEmbed
Ord, SelfEmbed -> Q Exp
SelfEmbed -> Q (TExp SelfEmbed)
(SelfEmbed -> Q Exp)
-> (SelfEmbed -> Q (TExp SelfEmbed)) -> Lift SelfEmbed
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SelfEmbed -> Q (TExp SelfEmbed)
$cliftTyped :: SelfEmbed -> Q (TExp SelfEmbed)
lift :: SelfEmbed -> Q Exp
$clift :: SelfEmbed -> Q Exp
Lift)

-- | Returns 'True' if the 'FieldDef' does not have a 'MigrationOnly' or
-- 'SafeToRemove' flag from the QuasiQuoter.
--
-- @since 2.13.0.0
isHaskellField :: FieldDef -> Bool
isHaskellField :: FieldDef -> Bool
isHaskellField FieldDef
fd =
    FieldAttr
FieldAttrMigrationOnly FieldAttr -> [FieldAttr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` FieldDef -> [FieldAttr]
fieldAttrs FieldDef
fd Bool -> Bool -> Bool
&&
    FieldAttr
FieldAttrSafeToRemove FieldAttr -> [FieldAttr] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` FieldDef -> [FieldAttr]
fieldAttrs FieldDef
fd

toEmbedEntityDef :: EntityDef -> EmbedEntityDef
toEmbedEntityDef :: EntityDef -> EmbedEntityDef
toEmbedEntityDef EntityDef
ent = EmbedEntityDef
embDef
  where
    embDef :: EmbedEntityDef
embDef = EmbedEntityDef :: EntityNameHS -> [EmbedFieldDef] -> EmbedEntityDef
EmbedEntityDef
        { embeddedHaskell :: EntityNameHS
embeddedHaskell = EntityDef -> EntityNameHS
entityHaskell EntityDef
ent
        , embeddedFields :: [EmbedFieldDef]
embeddedFields =
            (FieldDef -> EmbedFieldDef) -> [FieldDef] -> [EmbedFieldDef]
forall a b. (a -> b) -> [a] -> [b]
map FieldDef -> EmbedFieldDef
toEmbedFieldDef
            ([FieldDef] -> [EmbedFieldDef]) -> [FieldDef] -> [EmbedFieldDef]
forall a b. (a -> b) -> a -> b
$ (FieldDef -> Bool) -> [FieldDef] -> [FieldDef]
forall a. (a -> Bool) -> [a] -> [a]
filter FieldDef -> Bool
isHaskellField
            ([FieldDef] -> [FieldDef]) -> [FieldDef] -> [FieldDef]
forall a b. (a -> b) -> a -> b
$ EntityDef -> [FieldDef]
entityFields EntityDef
ent
        }
    toEmbedFieldDef :: FieldDef -> EmbedFieldDef
    toEmbedFieldDef :: FieldDef -> EmbedFieldDef
toEmbedFieldDef FieldDef
field =
        EmbedFieldDef :: FieldNameDB
-> Maybe (Either SelfEmbed EntityNameHS) -> EmbedFieldDef
EmbedFieldDef
            { emFieldDB :: FieldNameDB
emFieldDB =
                FieldDef -> FieldNameDB
fieldDB FieldDef
field
            , emFieldEmbed :: Maybe (Either SelfEmbed EntityNameHS)
emFieldEmbed =
                case FieldDef -> ReferenceDef
fieldReference FieldDef
field of
                    EmbedRef EntityNameHS
em ->
                        Either SelfEmbed EntityNameHS
-> Maybe (Either SelfEmbed EntityNameHS)
forall a. a -> Maybe a
Just (Either SelfEmbed EntityNameHS
 -> Maybe (Either SelfEmbed EntityNameHS))
-> Either SelfEmbed EntityNameHS
-> Maybe (Either SelfEmbed EntityNameHS)
forall a b. (a -> b) -> a -> b
$ EntityNameHS -> Either SelfEmbed EntityNameHS
forall a b. b -> Either a b
Right EntityNameHS
em
                    ReferenceDef
SelfReference -> Either SelfEmbed EntityNameHS
-> Maybe (Either SelfEmbed EntityNameHS)
forall a. a -> Maybe a
Just (Either SelfEmbed EntityNameHS
 -> Maybe (Either SelfEmbed EntityNameHS))
-> Either SelfEmbed EntityNameHS
-> Maybe (Either SelfEmbed EntityNameHS)
forall a b. (a -> b) -> a -> b
$ SelfEmbed -> Either SelfEmbed EntityNameHS
forall a b. a -> Either a b
Left SelfEmbed
SelfEmbed
                    ReferenceDef
_ -> Maybe (Either SelfEmbed EntityNameHS)
forall a. Maybe a
Nothing
            }

-- | Type for storing the Uniqueness constraint in the Schema.  Assume you have
-- the following schema with a uniqueness constraint:
--
-- @
-- Person
--   name String
--   age Int
--   UniqueAge age
-- @
--
-- This will be represented as:
--
-- @
-- UniqueDef
--     { uniqueHaskell = ConstraintNameHS (packPTH "UniqueAge")
--     , uniqueDBName = ConstraintNameDB (packPTH "unique_age")
--     , uniqueFields = [(FieldNameHS (packPTH "age"), FieldNameDB (packPTH "age"))]
--     , uniqueAttrs = []
--     }
-- @
--
data UniqueDef = UniqueDef
    { UniqueDef -> ConstraintNameHS
uniqueHaskell :: !ConstraintNameHS
    , UniqueDef -> ConstraintNameDB
uniqueDBName  :: !ConstraintNameDB
    , UniqueDef -> NonEmpty (FieldNameHS, FieldNameDB)
uniqueFields  :: !(NonEmpty (FieldNameHS, FieldNameDB))
    , UniqueDef -> [Text]
uniqueAttrs   :: ![Attr]
    }
    deriving (Int -> UniqueDef -> ShowS
[UniqueDef] -> ShowS
UniqueDef -> String
(Int -> UniqueDef -> ShowS)
-> (UniqueDef -> String)
-> ([UniqueDef] -> ShowS)
-> Show UniqueDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UniqueDef] -> ShowS
$cshowList :: [UniqueDef] -> ShowS
show :: UniqueDef -> String
$cshow :: UniqueDef -> String
showsPrec :: Int -> UniqueDef -> ShowS
$cshowsPrec :: Int -> UniqueDef -> ShowS
Show, UniqueDef -> UniqueDef -> Bool
(UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> Bool) -> Eq UniqueDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UniqueDef -> UniqueDef -> Bool
$c/= :: UniqueDef -> UniqueDef -> Bool
== :: UniqueDef -> UniqueDef -> Bool
$c== :: UniqueDef -> UniqueDef -> Bool
Eq, ReadPrec [UniqueDef]
ReadPrec UniqueDef
Int -> ReadS UniqueDef
ReadS [UniqueDef]
(Int -> ReadS UniqueDef)
-> ReadS [UniqueDef]
-> ReadPrec UniqueDef
-> ReadPrec [UniqueDef]
-> Read UniqueDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UniqueDef]
$creadListPrec :: ReadPrec [UniqueDef]
readPrec :: ReadPrec UniqueDef
$creadPrec :: ReadPrec UniqueDef
readList :: ReadS [UniqueDef]
$creadList :: ReadS [UniqueDef]
readsPrec :: Int -> ReadS UniqueDef
$creadsPrec :: Int -> ReadS UniqueDef
Read, Eq UniqueDef
Eq UniqueDef
-> (UniqueDef -> UniqueDef -> Ordering)
-> (UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> Bool)
-> (UniqueDef -> UniqueDef -> UniqueDef)
-> (UniqueDef -> UniqueDef -> UniqueDef)
-> Ord UniqueDef
UniqueDef -> UniqueDef -> Bool
UniqueDef -> UniqueDef -> Ordering
UniqueDef -> UniqueDef -> UniqueDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UniqueDef -> UniqueDef -> UniqueDef
$cmin :: UniqueDef -> UniqueDef -> UniqueDef
max :: UniqueDef -> UniqueDef -> UniqueDef
$cmax :: UniqueDef -> UniqueDef -> UniqueDef
>= :: UniqueDef -> UniqueDef -> Bool
$c>= :: UniqueDef -> UniqueDef -> Bool
> :: UniqueDef -> UniqueDef -> Bool
$c> :: UniqueDef -> UniqueDef -> Bool
<= :: UniqueDef -> UniqueDef -> Bool
$c<= :: UniqueDef -> UniqueDef -> Bool
< :: UniqueDef -> UniqueDef -> Bool
$c< :: UniqueDef -> UniqueDef -> Bool
compare :: UniqueDef -> UniqueDef -> Ordering
$ccompare :: UniqueDef -> UniqueDef -> Ordering
$cp1Ord :: Eq UniqueDef
Ord, UniqueDef -> Q Exp
UniqueDef -> Q (TExp UniqueDef)
(UniqueDef -> Q Exp)
-> (UniqueDef -> Q (TExp UniqueDef)) -> Lift UniqueDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: UniqueDef -> Q (TExp UniqueDef)
$cliftTyped :: UniqueDef -> Q (TExp UniqueDef)
lift :: UniqueDef -> Q Exp
$clift :: UniqueDef -> Q Exp
Lift)

data CompositeDef = CompositeDef
    { CompositeDef -> NonEmpty FieldDef
compositeFields  :: !(NonEmpty FieldDef)
    , CompositeDef -> [Text]
compositeAttrs   :: ![Attr]
    }
    deriving (Int -> CompositeDef -> ShowS
[CompositeDef] -> ShowS
CompositeDef -> String
(Int -> CompositeDef -> ShowS)
-> (CompositeDef -> String)
-> ([CompositeDef] -> ShowS)
-> Show CompositeDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompositeDef] -> ShowS
$cshowList :: [CompositeDef] -> ShowS
show :: CompositeDef -> String
$cshow :: CompositeDef -> String
showsPrec :: Int -> CompositeDef -> ShowS
$cshowsPrec :: Int -> CompositeDef -> ShowS
Show, CompositeDef -> CompositeDef -> Bool
(CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> Bool) -> Eq CompositeDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompositeDef -> CompositeDef -> Bool
$c/= :: CompositeDef -> CompositeDef -> Bool
== :: CompositeDef -> CompositeDef -> Bool
$c== :: CompositeDef -> CompositeDef -> Bool
Eq, ReadPrec [CompositeDef]
ReadPrec CompositeDef
Int -> ReadS CompositeDef
ReadS [CompositeDef]
(Int -> ReadS CompositeDef)
-> ReadS [CompositeDef]
-> ReadPrec CompositeDef
-> ReadPrec [CompositeDef]
-> Read CompositeDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompositeDef]
$creadListPrec :: ReadPrec [CompositeDef]
readPrec :: ReadPrec CompositeDef
$creadPrec :: ReadPrec CompositeDef
readList :: ReadS [CompositeDef]
$creadList :: ReadS [CompositeDef]
readsPrec :: Int -> ReadS CompositeDef
$creadsPrec :: Int -> ReadS CompositeDef
Read, Eq CompositeDef
Eq CompositeDef
-> (CompositeDef -> CompositeDef -> Ordering)
-> (CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> Bool)
-> (CompositeDef -> CompositeDef -> CompositeDef)
-> (CompositeDef -> CompositeDef -> CompositeDef)
-> Ord CompositeDef
CompositeDef -> CompositeDef -> Bool
CompositeDef -> CompositeDef -> Ordering
CompositeDef -> CompositeDef -> CompositeDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompositeDef -> CompositeDef -> CompositeDef
$cmin :: CompositeDef -> CompositeDef -> CompositeDef
max :: CompositeDef -> CompositeDef -> CompositeDef
$cmax :: CompositeDef -> CompositeDef -> CompositeDef
>= :: CompositeDef -> CompositeDef -> Bool
$c>= :: CompositeDef -> CompositeDef -> Bool
> :: CompositeDef -> CompositeDef -> Bool
$c> :: CompositeDef -> CompositeDef -> Bool
<= :: CompositeDef -> CompositeDef -> Bool
$c<= :: CompositeDef -> CompositeDef -> Bool
< :: CompositeDef -> CompositeDef -> Bool
$c< :: CompositeDef -> CompositeDef -> Bool
compare :: CompositeDef -> CompositeDef -> Ordering
$ccompare :: CompositeDef -> CompositeDef -> Ordering
$cp1Ord :: Eq CompositeDef
Ord, CompositeDef -> Q Exp
CompositeDef -> Q (TExp CompositeDef)
(CompositeDef -> Q Exp)
-> (CompositeDef -> Q (TExp CompositeDef)) -> Lift CompositeDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: CompositeDef -> Q (TExp CompositeDef)
$cliftTyped :: CompositeDef -> Q (TExp CompositeDef)
lift :: CompositeDef -> Q Exp
$clift :: CompositeDef -> Q Exp
Lift)

-- | Used instead of FieldDef
-- to generate a smaller amount of code
type ForeignFieldDef = (FieldNameHS, FieldNameDB)

data ForeignDef = ForeignDef
    { ForeignDef -> EntityNameHS
foreignRefTableHaskell       :: !EntityNameHS
    , ForeignDef -> EntityNameDB
foreignRefTableDBName        :: !EntityNameDB
    , ForeignDef -> ConstraintNameHS
foreignConstraintNameHaskell :: !ConstraintNameHS
    , ForeignDef -> ConstraintNameDB
foreignConstraintNameDBName  :: !ConstraintNameDB
    , ForeignDef -> FieldCascade
foreignFieldCascade          :: !FieldCascade
    -- ^ Determine how the field will cascade on updates and deletions.
    --
    -- @since 2.11.0
    , ForeignDef
-> [((FieldNameHS, FieldNameDB), (FieldNameHS, FieldNameDB))]
foreignFields                :: ![(ForeignFieldDef, ForeignFieldDef)] -- this entity plus the primary entity
    , ForeignDef -> [Text]
foreignAttrs                 :: ![Attr]
    , ForeignDef -> Bool
foreignNullable              :: Bool
    , ForeignDef -> Bool
foreignToPrimary             :: Bool
    -- ^ Determines if the reference is towards a Primary Key or not.
    --
    -- @since 2.11.0
    }
    deriving (Int -> ForeignDef -> ShowS
[ForeignDef] -> ShowS
ForeignDef -> String
(Int -> ForeignDef -> ShowS)
-> (ForeignDef -> String)
-> ([ForeignDef] -> ShowS)
-> Show ForeignDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ForeignDef] -> ShowS
$cshowList :: [ForeignDef] -> ShowS
show :: ForeignDef -> String
$cshow :: ForeignDef -> String
showsPrec :: Int -> ForeignDef -> ShowS
$cshowsPrec :: Int -> ForeignDef -> ShowS
Show, ForeignDef -> ForeignDef -> Bool
(ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> Bool) -> Eq ForeignDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ForeignDef -> ForeignDef -> Bool
$c/= :: ForeignDef -> ForeignDef -> Bool
== :: ForeignDef -> ForeignDef -> Bool
$c== :: ForeignDef -> ForeignDef -> Bool
Eq, ReadPrec [ForeignDef]
ReadPrec ForeignDef
Int -> ReadS ForeignDef
ReadS [ForeignDef]
(Int -> ReadS ForeignDef)
-> ReadS [ForeignDef]
-> ReadPrec ForeignDef
-> ReadPrec [ForeignDef]
-> Read ForeignDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ForeignDef]
$creadListPrec :: ReadPrec [ForeignDef]
readPrec :: ReadPrec ForeignDef
$creadPrec :: ReadPrec ForeignDef
readList :: ReadS [ForeignDef]
$creadList :: ReadS [ForeignDef]
readsPrec :: Int -> ReadS ForeignDef
$creadsPrec :: Int -> ReadS ForeignDef
Read, Eq ForeignDef
Eq ForeignDef
-> (ForeignDef -> ForeignDef -> Ordering)
-> (ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> Bool)
-> (ForeignDef -> ForeignDef -> ForeignDef)
-> (ForeignDef -> ForeignDef -> ForeignDef)
-> Ord ForeignDef
ForeignDef -> ForeignDef -> Bool
ForeignDef -> ForeignDef -> Ordering
ForeignDef -> ForeignDef -> ForeignDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ForeignDef -> ForeignDef -> ForeignDef
$cmin :: ForeignDef -> ForeignDef -> ForeignDef
max :: ForeignDef -> ForeignDef -> ForeignDef
$cmax :: ForeignDef -> ForeignDef -> ForeignDef
>= :: ForeignDef -> ForeignDef -> Bool
$c>= :: ForeignDef -> ForeignDef -> Bool
> :: ForeignDef -> ForeignDef -> Bool
$c> :: ForeignDef -> ForeignDef -> Bool
<= :: ForeignDef -> ForeignDef -> Bool
$c<= :: ForeignDef -> ForeignDef -> Bool
< :: ForeignDef -> ForeignDef -> Bool
$c< :: ForeignDef -> ForeignDef -> Bool
compare :: ForeignDef -> ForeignDef -> Ordering
$ccompare :: ForeignDef -> ForeignDef -> Ordering
$cp1Ord :: Eq ForeignDef
Ord, ForeignDef -> Q Exp
ForeignDef -> Q (TExp ForeignDef)
(ForeignDef -> Q Exp)
-> (ForeignDef -> Q (TExp ForeignDef)) -> Lift ForeignDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: ForeignDef -> Q (TExp ForeignDef)
$cliftTyped :: ForeignDef -> Q (TExp ForeignDef)
lift :: ForeignDef -> Q Exp
$clift :: ForeignDef -> Q Exp
Lift)

-- | This datatype describes how a foreign reference field cascades deletes
-- or updates.
--
-- This type is used in both parsing the model definitions and performing
-- migrations. A 'Nothing' in either of the field values means that the
-- user has not specified a 'CascadeAction'. An unspecified 'CascadeAction'
-- is defaulted to 'Restrict' when doing migrations.
--
-- @since 2.11.0
data FieldCascade = FieldCascade
    { FieldCascade -> Maybe CascadeAction
fcOnUpdate :: !(Maybe CascadeAction)
    , FieldCascade -> Maybe CascadeAction
fcOnDelete :: !(Maybe CascadeAction)
    }
    deriving (Int -> FieldCascade -> ShowS
[FieldCascade] -> ShowS
FieldCascade -> String
(Int -> FieldCascade -> ShowS)
-> (FieldCascade -> String)
-> ([FieldCascade] -> ShowS)
-> Show FieldCascade
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldCascade] -> ShowS
$cshowList :: [FieldCascade] -> ShowS
show :: FieldCascade -> String
$cshow :: FieldCascade -> String
showsPrec :: Int -> FieldCascade -> ShowS
$cshowsPrec :: Int -> FieldCascade -> ShowS
Show, FieldCascade -> FieldCascade -> Bool
(FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> Bool) -> Eq FieldCascade
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldCascade -> FieldCascade -> Bool
$c/= :: FieldCascade -> FieldCascade -> Bool
== :: FieldCascade -> FieldCascade -> Bool
$c== :: FieldCascade -> FieldCascade -> Bool
Eq, ReadPrec [FieldCascade]
ReadPrec FieldCascade
Int -> ReadS FieldCascade
ReadS [FieldCascade]
(Int -> ReadS FieldCascade)
-> ReadS [FieldCascade]
-> ReadPrec FieldCascade
-> ReadPrec [FieldCascade]
-> Read FieldCascade
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldCascade]
$creadListPrec :: ReadPrec [FieldCascade]
readPrec :: ReadPrec FieldCascade
$creadPrec :: ReadPrec FieldCascade
readList :: ReadS [FieldCascade]
$creadList :: ReadS [FieldCascade]
readsPrec :: Int -> ReadS FieldCascade
$creadsPrec :: Int -> ReadS FieldCascade
Read, Eq FieldCascade
Eq FieldCascade
-> (FieldCascade -> FieldCascade -> Ordering)
-> (FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> Bool)
-> (FieldCascade -> FieldCascade -> FieldCascade)
-> (FieldCascade -> FieldCascade -> FieldCascade)
-> Ord FieldCascade
FieldCascade -> FieldCascade -> Bool
FieldCascade -> FieldCascade -> Ordering
FieldCascade -> FieldCascade -> FieldCascade
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldCascade -> FieldCascade -> FieldCascade
$cmin :: FieldCascade -> FieldCascade -> FieldCascade
max :: FieldCascade -> FieldCascade -> FieldCascade
$cmax :: FieldCascade -> FieldCascade -> FieldCascade
>= :: FieldCascade -> FieldCascade -> Bool
$c>= :: FieldCascade -> FieldCascade -> Bool
> :: FieldCascade -> FieldCascade -> Bool
$c> :: FieldCascade -> FieldCascade -> Bool
<= :: FieldCascade -> FieldCascade -> Bool
$c<= :: FieldCascade -> FieldCascade -> Bool
< :: FieldCascade -> FieldCascade -> Bool
$c< :: FieldCascade -> FieldCascade -> Bool
compare :: FieldCascade -> FieldCascade -> Ordering
$ccompare :: FieldCascade -> FieldCascade -> Ordering
$cp1Ord :: Eq FieldCascade
Ord, FieldCascade -> Q Exp
FieldCascade -> Q (TExp FieldCascade)
(FieldCascade -> Q Exp)
-> (FieldCascade -> Q (TExp FieldCascade)) -> Lift FieldCascade
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FieldCascade -> Q (TExp FieldCascade)
$cliftTyped :: FieldCascade -> Q (TExp FieldCascade)
lift :: FieldCascade -> Q Exp
$clift :: FieldCascade -> Q Exp
Lift)

-- | A 'FieldCascade' that does nothing.
--
-- @since 2.11.0
noCascade :: FieldCascade
noCascade :: FieldCascade
noCascade = Maybe CascadeAction -> Maybe CascadeAction -> FieldCascade
FieldCascade Maybe CascadeAction
forall a. Maybe a
Nothing Maybe CascadeAction
forall a. Maybe a
Nothing

-- | Renders a 'FieldCascade' value such that it can be used in SQL
-- migrations.
--
-- @since 2.11.0
renderFieldCascade :: FieldCascade -> Text
renderFieldCascade :: FieldCascade -> Text
renderFieldCascade (FieldCascade Maybe CascadeAction
onUpdate Maybe CascadeAction
onDelete) =
    [Text] -> Text
T.unwords
        [ (CascadeAction -> Text) -> Maybe CascadeAction -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
" ON DELETE " (Text -> Text) -> (CascadeAction -> Text) -> CascadeAction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CascadeAction -> Text
renderCascadeAction) Maybe CascadeAction
onDelete
        , (CascadeAction -> Text) -> Maybe CascadeAction -> Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Text -> Text -> Text
forall a. Monoid a => a -> a -> a
mappend Text
" ON UPDATE " (Text -> Text) -> (CascadeAction -> Text) -> CascadeAction -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CascadeAction -> Text
renderCascadeAction) Maybe CascadeAction
onUpdate
        ]

-- | An action that might happen on a deletion or update on a foreign key
-- change.
--
-- @since 2.11.0
data CascadeAction = Cascade | Restrict | SetNull | SetDefault
    deriving (Int -> CascadeAction -> ShowS
[CascadeAction] -> ShowS
CascadeAction -> String
(Int -> CascadeAction -> ShowS)
-> (CascadeAction -> String)
-> ([CascadeAction] -> ShowS)
-> Show CascadeAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CascadeAction] -> ShowS
$cshowList :: [CascadeAction] -> ShowS
show :: CascadeAction -> String
$cshow :: CascadeAction -> String
showsPrec :: Int -> CascadeAction -> ShowS
$cshowsPrec :: Int -> CascadeAction -> ShowS
Show, CascadeAction -> CascadeAction -> Bool
(CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> Bool) -> Eq CascadeAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CascadeAction -> CascadeAction -> Bool
$c/= :: CascadeAction -> CascadeAction -> Bool
== :: CascadeAction -> CascadeAction -> Bool
$c== :: CascadeAction -> CascadeAction -> Bool
Eq, ReadPrec [CascadeAction]
ReadPrec CascadeAction
Int -> ReadS CascadeAction
ReadS [CascadeAction]
(Int -> ReadS CascadeAction)
-> ReadS [CascadeAction]
-> ReadPrec CascadeAction
-> ReadPrec [CascadeAction]
-> Read CascadeAction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CascadeAction]
$creadListPrec :: ReadPrec [CascadeAction]
readPrec :: ReadPrec CascadeAction
$creadPrec :: ReadPrec CascadeAction
readList :: ReadS [CascadeAction]
$creadList :: ReadS [CascadeAction]
readsPrec :: Int -> ReadS CascadeAction
$creadsPrec :: Int -> ReadS CascadeAction
Read, Eq CascadeAction
Eq CascadeAction
-> (CascadeAction -> CascadeAction -> Ordering)
-> (CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> Bool)
-> (CascadeAction -> CascadeAction -> CascadeAction)
-> (CascadeAction -> CascadeAction -> CascadeAction)
-> Ord CascadeAction
CascadeAction -> CascadeAction -> Bool
CascadeAction -> CascadeAction -> Ordering
CascadeAction -> CascadeAction -> CascadeAction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CascadeAction -> CascadeAction -> CascadeAction
$cmin :: CascadeAction -> CascadeAction -> CascadeAction
max :: CascadeAction -> CascadeAction -> CascadeAction
$cmax :: CascadeAction -> CascadeAction -> CascadeAction
>= :: CascadeAction -> CascadeAction -> Bool
$c>= :: CascadeAction -> CascadeAction -> Bool
> :: CascadeAction -> CascadeAction -> Bool
$c> :: CascadeAction -> CascadeAction -> Bool
<= :: CascadeAction -> CascadeAction -> Bool
$c<= :: CascadeAction -> CascadeAction -> Bool
< :: CascadeAction -> CascadeAction -> Bool
$c< :: CascadeAction -> CascadeAction -> Bool
compare :: CascadeAction -> CascadeAction -> Ordering
$ccompare :: CascadeAction -> CascadeAction -> Ordering
$cp1Ord :: Eq CascadeAction
Ord, CascadeAction -> Q Exp
CascadeAction -> Q (TExp CascadeAction)
(CascadeAction -> Q Exp)
-> (CascadeAction -> Q (TExp CascadeAction)) -> Lift CascadeAction
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: CascadeAction -> Q (TExp CascadeAction)
$cliftTyped :: CascadeAction -> Q (TExp CascadeAction)
lift :: CascadeAction -> Q Exp
$clift :: CascadeAction -> Q Exp
Lift)

-- | Render a 'CascadeAction' to 'Text' such that it can be used in a SQL
-- command.
--
-- @since 2.11.0
renderCascadeAction :: CascadeAction -> Text
renderCascadeAction :: CascadeAction -> Text
renderCascadeAction CascadeAction
action = case CascadeAction
action of
  CascadeAction
Cascade    -> Text
"CASCADE"
  CascadeAction
Restrict   -> Text
"RESTRICT"
  CascadeAction
SetNull    -> Text
"SET NULL"
  CascadeAction
SetDefault -> Text
"SET DEFAULT"

data PersistException
  = PersistError Text -- ^ Generic Exception
  | PersistMarshalError Text
  | PersistInvalidField Text
  | PersistForeignConstraintUnmet Text
  | PersistMongoDBError Text
  | PersistMongoDBUnsupported Text
    deriving Int -> PersistException -> ShowS
[PersistException] -> ShowS
PersistException -> String
(Int -> PersistException -> ShowS)
-> (PersistException -> String)
-> ([PersistException] -> ShowS)
-> Show PersistException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistException] -> ShowS
$cshowList :: [PersistException] -> ShowS
show :: PersistException -> String
$cshow :: PersistException -> String
showsPrec :: Int -> PersistException -> ShowS
$cshowsPrec :: Int -> PersistException -> ShowS
Show

instance Exception PersistException

-- | A SQL data type. Naming attempts to reflect the underlying Haskell
-- datatypes, eg SqlString instead of SqlVarchar. Different SQL databases may
-- have different translations for these types.
data SqlType = SqlString
             | SqlInt32
             | SqlInt64
             | SqlReal
             | SqlNumeric Word32 Word32
             | SqlBool
             | SqlDay
             | SqlTime
             | SqlDayTime -- ^ Always uses UTC timezone
             | SqlBlob
             | SqlOther T.Text -- ^ a backend-specific name
    deriving (Int -> SqlType -> ShowS
[SqlType] -> ShowS
SqlType -> String
(Int -> SqlType -> ShowS)
-> (SqlType -> String) -> ([SqlType] -> ShowS) -> Show SqlType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SqlType] -> ShowS
$cshowList :: [SqlType] -> ShowS
show :: SqlType -> String
$cshow :: SqlType -> String
showsPrec :: Int -> SqlType -> ShowS
$cshowsPrec :: Int -> SqlType -> ShowS
Show, ReadPrec [SqlType]
ReadPrec SqlType
Int -> ReadS SqlType
ReadS [SqlType]
(Int -> ReadS SqlType)
-> ReadS [SqlType]
-> ReadPrec SqlType
-> ReadPrec [SqlType]
-> Read SqlType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SqlType]
$creadListPrec :: ReadPrec [SqlType]
readPrec :: ReadPrec SqlType
$creadPrec :: ReadPrec SqlType
readList :: ReadS [SqlType]
$creadList :: ReadS [SqlType]
readsPrec :: Int -> ReadS SqlType
$creadsPrec :: Int -> ReadS SqlType
Read, SqlType -> SqlType -> Bool
(SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool) -> Eq SqlType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqlType -> SqlType -> Bool
$c/= :: SqlType -> SqlType -> Bool
== :: SqlType -> SqlType -> Bool
$c== :: SqlType -> SqlType -> Bool
Eq, Eq SqlType
Eq SqlType
-> (SqlType -> SqlType -> Ordering)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> Bool)
-> (SqlType -> SqlType -> SqlType)
-> (SqlType -> SqlType -> SqlType)
-> Ord SqlType
SqlType -> SqlType -> Bool
SqlType -> SqlType -> Ordering
SqlType -> SqlType -> SqlType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SqlType -> SqlType -> SqlType
$cmin :: SqlType -> SqlType -> SqlType
max :: SqlType -> SqlType -> SqlType
$cmax :: SqlType -> SqlType -> SqlType
>= :: SqlType -> SqlType -> Bool
$c>= :: SqlType -> SqlType -> Bool
> :: SqlType -> SqlType -> Bool
$c> :: SqlType -> SqlType -> Bool
<= :: SqlType -> SqlType -> Bool
$c<= :: SqlType -> SqlType -> Bool
< :: SqlType -> SqlType -> Bool
$c< :: SqlType -> SqlType -> Bool
compare :: SqlType -> SqlType -> Ordering
$ccompare :: SqlType -> SqlType -> Ordering
$cp1Ord :: Eq SqlType
Ord, SqlType -> Q Exp
SqlType -> Q (TExp SqlType)
(SqlType -> Q Exp) -> (SqlType -> Q (TExp SqlType)) -> Lift SqlType
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: SqlType -> Q (TExp SqlType)
$cliftTyped :: SqlType -> Q (TExp SqlType)
lift :: SqlType -> Q Exp
$clift :: SqlType -> Q Exp
Lift)

data PersistFilter = Eq | Ne | Gt | Lt | Ge | Le | In | NotIn
                   | BackendSpecificFilter T.Text
    deriving (ReadPrec [PersistFilter]
ReadPrec PersistFilter
Int -> ReadS PersistFilter
ReadS [PersistFilter]
(Int -> ReadS PersistFilter)
-> ReadS [PersistFilter]
-> ReadPrec PersistFilter
-> ReadPrec [PersistFilter]
-> Read PersistFilter
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PersistFilter]
$creadListPrec :: ReadPrec [PersistFilter]
readPrec :: ReadPrec PersistFilter
$creadPrec :: ReadPrec PersistFilter
readList :: ReadS [PersistFilter]
$creadList :: ReadS [PersistFilter]
readsPrec :: Int -> ReadS PersistFilter
$creadsPrec :: Int -> ReadS PersistFilter
Read, Int -> PersistFilter -> ShowS
[PersistFilter] -> ShowS
PersistFilter -> String
(Int -> PersistFilter -> ShowS)
-> (PersistFilter -> String)
-> ([PersistFilter] -> ShowS)
-> Show PersistFilter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistFilter] -> ShowS
$cshowList :: [PersistFilter] -> ShowS
show :: PersistFilter -> String
$cshow :: PersistFilter -> String
showsPrec :: Int -> PersistFilter -> ShowS
$cshowsPrec :: Int -> PersistFilter -> ShowS
Show, PersistFilter -> Q Exp
PersistFilter -> Q (TExp PersistFilter)
(PersistFilter -> Q Exp)
-> (PersistFilter -> Q (TExp PersistFilter)) -> Lift PersistFilter
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: PersistFilter -> Q (TExp PersistFilter)
$cliftTyped :: PersistFilter -> Q (TExp PersistFilter)
lift :: PersistFilter -> Q Exp
$clift :: PersistFilter -> Q Exp
Lift)

data UpdateException = KeyNotFound String
                     | UpsertError String
instance Show UpdateException where
    show :: UpdateException -> String
show (KeyNotFound String
key) = String
"Key not found during updateGet: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key
    show (UpsertError String
msg) = String
"Error during upsert: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg
instance Exception UpdateException

data OnlyUniqueException = OnlyUniqueException String
instance Show OnlyUniqueException where
    show :: OnlyUniqueException -> String
show (OnlyUniqueException String
uniqueMsg) =
      String
"Expected only one unique key, got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
uniqueMsg
instance Exception OnlyUniqueException


data PersistUpdate
    = Assign | Add | Subtract | Multiply | Divide
    | BackendSpecificUpdate T.Text
    deriving (ReadPrec [PersistUpdate]
ReadPrec PersistUpdate
Int -> ReadS PersistUpdate
ReadS [PersistUpdate]
(Int -> ReadS PersistUpdate)
-> ReadS [PersistUpdate]
-> ReadPrec PersistUpdate
-> ReadPrec [PersistUpdate]
-> Read PersistUpdate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PersistUpdate]
$creadListPrec :: ReadPrec [PersistUpdate]
readPrec :: ReadPrec PersistUpdate
$creadPrec :: ReadPrec PersistUpdate
readList :: ReadS [PersistUpdate]
$creadList :: ReadS [PersistUpdate]
readsPrec :: Int -> ReadS PersistUpdate
$creadsPrec :: Int -> ReadS PersistUpdate
Read, Int -> PersistUpdate -> ShowS
[PersistUpdate] -> ShowS
PersistUpdate -> String
(Int -> PersistUpdate -> ShowS)
-> (PersistUpdate -> String)
-> ([PersistUpdate] -> ShowS)
-> Show PersistUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PersistUpdate] -> ShowS
$cshowList :: [PersistUpdate] -> ShowS
show :: PersistUpdate -> String
$cshow :: PersistUpdate -> String
showsPrec :: Int -> PersistUpdate -> ShowS
$cshowsPrec :: Int -> PersistUpdate -> ShowS
Show, PersistUpdate -> Q Exp
PersistUpdate -> Q (TExp PersistUpdate)
(PersistUpdate -> Q Exp)
-> (PersistUpdate -> Q (TExp PersistUpdate)) -> Lift PersistUpdate
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: PersistUpdate -> Q (TExp PersistUpdate)
$cliftTyped :: PersistUpdate -> Q (TExp PersistUpdate)
lift :: PersistUpdate -> Q Exp
$clift :: PersistUpdate -> Q Exp
Lift)

-- | A 'FieldDef' represents the inormation that @persistent@ knows about
-- a field of a datatype. This includes information used to parse the field
-- out of the database and what the field corresponds to.
data FieldDef = FieldDef
    { FieldDef -> FieldNameHS
fieldHaskell   :: !FieldNameHS
    -- ^ The name of the field. Note that this does not corresponds to the
    -- record labels generated for the particular entity - record labels
    -- are generated with the type name prefixed to the field, so
    -- a 'FieldDef' that contains a @'FieldNameHS' "name"@ for a type
    -- @User@ will have a record field @userName@.
    , FieldDef -> FieldNameDB
fieldDB        :: !FieldNameDB
    -- ^ The name of the field in the database. For SQL databases, this
    -- corresponds to the column name.
    , FieldDef -> FieldType
fieldType      :: !FieldType
    -- ^ The type of the field in Haskell.
    , FieldDef -> SqlType
fieldSqlType   :: !SqlType
    -- ^ The type of the field in a SQL database.
    , FieldDef -> [FieldAttr]
fieldAttrs     :: ![FieldAttr]
    -- ^ User annotations for a field. These are provided with the @!@
    -- operator.
    , FieldDef -> Bool
fieldStrict    :: !Bool
    -- ^ If this is 'True', then the Haskell datatype will have a strict
    -- record field. The default value for this is 'True'.
    , FieldDef -> ReferenceDef
fieldReference :: !ReferenceDef
    , FieldDef -> FieldCascade
fieldCascade :: !FieldCascade
    -- ^ Defines how operations on the field cascade on to the referenced
    -- tables. This doesn't have any meaning if the 'fieldReference' is set
    -- to 'NoReference' or 'SelfReference'. The cascade option here should
    -- be the same as the one obtained in the 'fieldReference'.
    --
    -- @since 2.11.0
    , FieldDef -> Maybe Text
fieldComments  :: !(Maybe Text)
    -- ^ Optional comments for a 'Field'. There is not currently a way to
    -- attach comments to a field in the quasiquoter.
    --
    -- @since 2.10.0
    , FieldDef -> Maybe Text
fieldGenerated :: !(Maybe Text)
    -- ^ Whether or not the field is a @GENERATED@ column, and additionally
    -- the expression to use for generation.
    --
    -- @since 2.11.0.0
    , FieldDef -> Bool
fieldIsImplicitIdColumn :: !Bool
    -- ^ 'True' if the field is an implicit ID column. 'False' otherwise.
    --
    -- @since 2.13.0.0
    }
    deriving (Int -> FieldDef -> ShowS
[FieldDef] -> ShowS
FieldDef -> String
(Int -> FieldDef -> ShowS)
-> (FieldDef -> String) -> ([FieldDef] -> ShowS) -> Show FieldDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldDef] -> ShowS
$cshowList :: [FieldDef] -> ShowS
show :: FieldDef -> String
$cshow :: FieldDef -> String
showsPrec :: Int -> FieldDef -> ShowS
$cshowsPrec :: Int -> FieldDef -> ShowS
Show, FieldDef -> FieldDef -> Bool
(FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> Bool) -> Eq FieldDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FieldDef -> FieldDef -> Bool
$c/= :: FieldDef -> FieldDef -> Bool
== :: FieldDef -> FieldDef -> Bool
$c== :: FieldDef -> FieldDef -> Bool
Eq, ReadPrec [FieldDef]
ReadPrec FieldDef
Int -> ReadS FieldDef
ReadS [FieldDef]
(Int -> ReadS FieldDef)
-> ReadS [FieldDef]
-> ReadPrec FieldDef
-> ReadPrec [FieldDef]
-> Read FieldDef
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FieldDef]
$creadListPrec :: ReadPrec [FieldDef]
readPrec :: ReadPrec FieldDef
$creadPrec :: ReadPrec FieldDef
readList :: ReadS [FieldDef]
$creadList :: ReadS [FieldDef]
readsPrec :: Int -> ReadS FieldDef
$creadsPrec :: Int -> ReadS FieldDef
Read, Eq FieldDef
Eq FieldDef
-> (FieldDef -> FieldDef -> Ordering)
-> (FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> Bool)
-> (FieldDef -> FieldDef -> FieldDef)
-> (FieldDef -> FieldDef -> FieldDef)
-> Ord FieldDef
FieldDef -> FieldDef -> Bool
FieldDef -> FieldDef -> Ordering
FieldDef -> FieldDef -> FieldDef
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FieldDef -> FieldDef -> FieldDef
$cmin :: FieldDef -> FieldDef -> FieldDef
max :: FieldDef -> FieldDef -> FieldDef
$cmax :: FieldDef -> FieldDef -> FieldDef
>= :: FieldDef -> FieldDef -> Bool
$c>= :: FieldDef -> FieldDef -> Bool
> :: FieldDef -> FieldDef -> Bool
$c> :: FieldDef -> FieldDef -> Bool
<= :: FieldDef -> FieldDef -> Bool
$c<= :: FieldDef -> FieldDef -> Bool
< :: FieldDef -> FieldDef -> Bool
$c< :: FieldDef -> FieldDef -> Bool
compare :: FieldDef -> FieldDef -> Ordering
$ccompare :: FieldDef -> FieldDef -> Ordering
$cp1Ord :: Eq FieldDef
Ord, FieldDef -> Q Exp
FieldDef -> Q (TExp FieldDef)
(FieldDef -> Q Exp)
-> (FieldDef -> Q (TExp FieldDef)) -> Lift FieldDef
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: FieldDef -> Q (TExp FieldDef)
$cliftTyped :: FieldDef -> Q (TExp FieldDef)
lift :: FieldDef -> Q Exp
$clift :: FieldDef -> Q Exp
Lift)